home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 172bbas.zip / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1989-07-25  |  113KB  |  3,282 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 05-28-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  ALLCAPS    58060   Convert a string to all upper case characters
  19. '  AMORPM     41498   Calculate the current time as AM or PM
  20. '  ASKGRAPH   43004   Determine users graphic default
  21. '  BADFILE    20741   Check for system crash attempt with bad device name
  22. '  CARRIER    42000   Test for Carrier present
  23. '  CHECKRATIO 20096   Test upload/download ratio
  24. '  CHECKTIM   58070   Test to insure that users don't exceed their time
  25. '  CHKNEWBUL  58110   Check for new bulletins based on their file creation date
  26. '  CHKTREMAIN 41008   Set up to log off if time exceeded
  27. '  COMMINFO   44020   Get users baud rate and parity in a string format
  28. '  CTLINES    58160   Count categories a file can be classified into
  29. '  CTNEWFILES 58150   Check for number of files uploaded after a specific date
  30. '  DELAYIT    50495   Wait number of seconds specified before returning
  31. '  DISPCALL   57001   Display callers file
  32. '  DISPLAYTR  41032   Compute and display time remaining
  33. '  DISUPDIR   58165   Display the shared directory of the FMS mng. sys.
  34. '  FILELOCK   21993   Allow files to be shared among multiple RBBS-PC's
  35. '  FINDFUNC   30595   Handle local keyboard's function & SYSOP's keys
  36. '  FINDLAST   58600   Finds last occurence of a string in a string
  37. '  FINDTIME   58050   Calculate the number of seconds since midnight
  38. '  GRAPHIC    43031   Determines whether graphic version of file exists
  39. '  HASHRBBS   58080   "Hash" to a user's record in the USERS file
  40. '  INITFMS    58162   Initialize the RBBS-PC's File Management System
  41. '  INITIBM    30000   Open/create NETBIOS semaphore file
  42. '  INSCOMMA   58130   Format commands in the command prompt
  43. '  LIBRARY    21105   Provide support for "library" drives
  44. '  LINESNFIL  58161   Counts lines in a file
  45. '  LOADNEW    58140   Find the latest uploads
  46. '  MODEMPUT   52070   Write a modem command string to the modem
  47. '  OPENMSG    30500   Open the messages file as file number 1
  48. '  PAGEUP     33202   Display user info. on local screen for SYSOP
  49. '  READPROF   44000   Read user's profile on return from a "door"
  50. '  SAVEPROF   43068   Save the user's provile when exiting to "doors" or DOS
  51. '  SENDNAME   20293   Send filename via EXEC-PC protocol during autodownload
  52. '  SETOPTS    58100   Set correct prompt line for each subsystem
  53. '  SRTSTRNG   58120   Sort characters in a string
  54. '  TESTUSER   20310   Check if user's software can do auto downloading
  55. '  TIMEREMAIN 41010   Compute time remaining in minutes
  56. '  UPDTUPLOAD 20705   Updates upload directory file
  57. '  WILDFILE   20290   Determines whether string matches a pattern
  58. '  XFERTYPE   21600   Identify the file transfer protocol
  59. '
  60. '  $INCLUDE: 'RBBS-VAR.BAS'
  61. '
  62. 20290 ' $SUBTITLE: 'WILDFILE -- Matches file to a filespec'
  63. ' $PAGE
  64. '  NAME    -- WILDFILE
  65. '
  66. '  INPUTS  -- PARAMETER             MEANING
  67. '             PATTERN$           PATTERN TO CHECK AGAINST
  68. '             ITEM.TO.MATCH$     FILE NAME TO MATCH
  69. '
  70. '  OUTPUTS -- DOES.MATCH         WHETHER MATCHES
  71. '
  72. '  PURPOSE  Determine whether a file name is an instance of
  73. '    a file specification.  Exactly like DOS except that ? must have a
  74. '    character.
  75. '
  76.       SUB WILDFILE (PATTERN$,ITEM.TO.MATCH$,DOES.MATCH) STATIC
  77.       IF PATTERN$ <> PREV.PATTERN$ THEN _
  78.          CALL BRKFNAME (PATTERN$,PDR$,PPREFIX$,PEXT$,FALSE) : _
  79.          PREV.PATTERN$ = PATTERN$
  80.       CALL BRKFNAME (ITEM.TO.MATCH$,IDR$,IPREFIX$,IEXT$,FALSE)
  81.       DOES.MATCH = FALSE
  82.       IF PDR$ <> "" AND PDR$ <> IDR$ THEN _
  83.          EXIT SUB
  84.       CALL WILDCARD (PPREFIX$,IPREFIX$)
  85.       IF NOT OK THEN _
  86.          EXIT SUB
  87.       CALL WILDCARD (PEXT$,IEXT$)
  88.       DOES.MATCH = OK
  89.       END SUB
  90. 20293 ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  91. ' $PAGE
  92. '
  93. '  NAME    -- SENDNAME
  94. '
  95. '  INPUTS  --  PARAMETER                    MEANING
  96. '              B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  97. '              DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  98. '
  99. '  OUTPUTS --  ABORT               -1 FOR AN ABORTED ATTEMPT
  100. '
  101. '  PURPOSE -- Send the download filename to user during an autodownload
  102. '
  103.       SUB SENDNAME STATIC
  104. '
  105. '
  106. ' *  TRANSFER FILENAME TO USER
  107. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
  108. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
  109. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
  110. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
  111. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
  112. ' *                   COMPLETION AND FILE TRANSFER BEGINS.
  113. '
  114. '
  115.       ABORT = FALSE                      ' RESET ABORT FLAG
  116.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  117. 20295 CALL DELAYIT (1)                   ' ONE SECOND DELAY
  118. 20296 CALL FLUSHCOM(Y$)                  ' CLEAR THE COMM BUFFER OF GARBAGE
  119.       IF SUBROUTINE.PARAMETER = -1 THEN _
  120.          EXIT SUB
  121.       CALL PUTCOM (ESCAPE$+"OD")         ' SEND "ALERT" STRING
  122.       IF SUBROUTINE.PARAMETER = -1 THEN _
  123.          EXIT SUB
  124.       IF ABORT = TRUE THEN _
  125.          GOTO 20306
  126.       CALL LPRNT("Sending FILENAME -- ",1)
  127.       CALL LPRNT(RETURN.LINE.FEED$ + CHR$(9),0)
  128.       CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  129. '
  130. '               SEND ONE CHARACTER AT A TIME
  131. '
  132.       CALL BRKFNAME (B$(DWN.INDEX),X$,A$,Y$,TRUE)
  133.       A$ = A$ + Y$ + "=X"
  134.       FOR X = 1 TO LEN(A$)
  135.          CALL PUTCOM (MID$(A$,X,1))     ' SEND 1 CHARACTER
  136.          IF SUBROUTINE.PARAMETER = -1 THEN _
  137.             EXIT SUB
  138.          IF ABORT = TRUE THEN _
  139.             GOTO 20306
  140.          CALL LPRNT(MID$(A$,X,1),0)     ' DISPLAY IF NEEDED
  141.          IF TIMER < 86390! THEN _
  142.             DELAY! = TIMER + 10 _
  143.          ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  144.          CHAR% = TRUE
  145.          WHILE CHAR% = -1
  146.             IF TIMER > DELAY! THEN _
  147.                GOTO 20300     ' IF NO ECHO, CANCEL FILENAME TRANSFER
  148.             CALL EOFCOMM (CHAR%)
  149.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  150. 20298    CALL FLUSHCOM(Y$)    ' COLLECT CHARACTER(S) USER ECHOED
  151.          IF SUBROUTINE.PARAMETER = -1 THEN _
  152.             EXIT SUB
  153.          IF MID$(A$,X,1) = Y$ THEN _
  154.             GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  155.          IF INSTR(Y$,CANCEL$) THEN _
  156.             ABORT = TRUE : _
  157.             GOTO 20306          ' CHECK FOR USER ABORT
  158. 20300    CALL PUTCOM (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  159.          IF SUBROUTINE.PARAMETER = - 1 THEN _
  160.             EXIT SUB
  161.          IF ABORT = TRUE THEN _
  162.             GOTO 20306
  163.          CALL LPRNT("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  164.          ATTEMPTS = ATTEMPTS + 1  ' INCREMENT COUNTER FOR # OF TRIES
  165.          IF ATTEMPTS < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  166.             GOTO 20295
  167.          CALL PUTCOM (STRING$(50,24)) ' GUARANTEE CANCELLATION OF USER
  168.          IF SUBROUTINE.PARAMETER = -1 THEN _
  169.             EXIT SUB
  170.          IF ABORT = TRUE THEN _
  171.             GOTO 20306
  172.          IF SNOOP THEN _
  173.             CALL LPRNT("ABORTING AUTODOWNLOAD!",1) : _
  174.             ABORT = TRUE : _
  175.             GOTO 20306
  176. '
  177. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  178. '
  179.       CALL PUTCOM (ACKNOWLEDGE$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  180.       IF SUBROUITNE.PARAMETER = -1 THEN _
  181.          EXIT SUB
  182.       CALL SKIPLINE(1)              ' CLEAN UP SYSOP'S DISPLAY
  183. '
  184. '                COMPLETION OF AUTODOWNLOAD FILENAME TRANSFER
  185. '
  186. 20306 END SUB
  187. 20310 ' $SUBTITLE: 'TESTUSER - interrogate user for AUTO-DOWNLOADING support'
  188. ' $PAGE
  189. '
  190. '  NAME    -- TESTUSER
  191. '
  192. '  INPUTS  -- NONE
  193. '
  194. '  OUTPUTS -- AUTODOWNLOAD.AVAILABLE   -1 IF USER'S COMMUNICATION
  195. '                                       SOFTWARE CAN DO AUTODOWNLOADING
  196. '
  197. '             AUTODOWNLOAD.VERIFIED    TRUE IF COMMUNICATIONS PGM
  198. '                                      EVER CHECKED
  199. '
  200. '  PURPOSE -- Send the user an <ESCAPE><XON> and if response
  201. '             is a recognized package, set appropriate flag.
  202. '
  203.       SUB TESTUSER STATIC
  204. '
  205. '
  206. ' *    TEST FOR COMMUNICATIONS USING N,8,1 PROTOCOL AND EXECPC TALK VER 2.0+
  207. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE
  208. '
  209. '
  210.       ABORT = FALSE
  211.       AUTODOWNLOAD.VERIFIED = TRUE
  212.       CALL FLUSHCOM(Y$)                          ' FLUSH THE COMM BUFFER
  213.       IF SUBROUTINE.PARAMETER = -1 THEN _
  214.          EXIT SUB
  215.       CALL PUTCOM (ESCAPE$ + XON$)
  216.       IF ABORT = TRUE THEN _
  217.          GOTO 20315
  218.       CALL DELAYIT (2)                            ' WAIT TWO SECONDS FOR REPLY
  219. 20313 CALL FLUSHCOM(Y$)                           ' GET CONTENTS OF COMM BUFFER
  220.       IF SUBROUTINE.PARAMETER = -1 THEN _
  221.          EXIT SUB
  222.       IF INSTR(Y$,"EXECPC") THEN _
  223.          COM.PROGRAM = 1
  224.       IF INSTR(Y$,"PIBTERM") THEN _
  225.          COM.PROGRAM = 2
  226.       IF INSTR(Y$,"PROCOMM") THEN _
  227.          COM.PROGRAM = 3
  228.       IF INSTR(Y$,"QMODEM") THEN _
  229.          COM.PROGRAM = 4
  230.       AUTODOWNLOAD.AVAILABLE = (COM.PROGRAM > 0 AND COM.PROGRAM < 3)
  231. 20315 END SUB
  232. 20705 ' $SUBTITLE: 'UPDTUPLOAD -- Updates upload directory'
  233. ' $PAGE
  234. '  NAME    -- UPDTUPLOAD
  235. '
  236. '  INPUTS  -- PARAMETER             MEANING
  237. '             FILE.NAME$
  238. '             UPLOAD.DIRECTORY$
  239. '             FILE.NAME.HOLD$
  240. '             SHARE.IT
  241. '             FMS.DIRECTORY$
  242. '             Q!
  243. '             TCA!
  244. '
  245. '  OUTPUTS -- BYTES.IN.FILE#
  246. '             SECONDS.PER.SESSION!
  247. '
  248. '  PURPOSE -- Upon a successful upload, add entry to the upload
  249. '             directory and give any session time credit.
  250. '
  251.       SUB UPDTUPLOAD (CATEGORY.NAME$(1),CATEGORY.CODE$(1), LINES.IN.DESC) STATIC
  252.       IF GET.EXT.DESC THEN _
  253.          GOTO 20723
  254.       GOSUB 20734
  255.       CALL TIMEREMAIN (TIME.REMAINING!)
  256.       IF PRIVATE.DOOR THEN _
  257.          X! = UPLOAD.TIME.FACTOR! * Q! _
  258.       ELSE X! = UPLOAD.TIME.FACTOR! * (TCA! - Q!)
  259.       CALL BRKFNAME (FILE.NAME$,PRE$,BODY$,EXT$,FALSE)
  260.       X$ = DISK.FOR.DOS$ + "T" + EXT$ + ".BAT"
  261.       CALL FINDIT (X$)
  262.       IF NOT OK THEN _
  263.          GOTO 20708
  264.       CALL QTPUT1 ("Verifying file integrity...") : _
  265.       CALL READDIR (2,1)
  266.       IF EOF(2) THEN _
  267.          X$ = A$ : _
  268.          GSR.ARA$(1) = FILE.NAME$ : _
  269.          GSR.ARA$(2) = NODE.WORK.FILE$ _
  270.       ELSE X$ = X$ + " " + _
  271.            FILE.NAME$ + " " + NODE.WORK.FILE$
  272.       CALL SHELLEXIT (X$)
  273.       CALL FINDIT (NODE.WORK.FILE$)
  274.       IF OK THEN _
  275.          IF LOF(2) > 2 THEN _
  276.             BYTES.IN.FILE# = 0.0 : _
  277.             X$ = "Deleting BAD upload " + FILE.NAME.HOLD$ : _
  278.             CALL QTPUT1 (X$) : _
  279.             CALL UPDTCALR (X$,2) : _
  280.             CALL KILLWORK (FILE.NAME$) : _
  281.             EXIT SUB
  282. 20708 X$ = DISK.FOR.DOS$ + "C" + EXT$ + DEFAULT.EXTENSION$ + ".BAT"
  283.       CALL FINDIT (X$)
  284.       IF NOT OK THEN _
  285.          GOTO 20709
  286.       A$ = "Converting"
  287.       IF EXT$ = DEFAULT.EXTENSION$ THEN _
  288.          A$ = "Re-" + A$
  289.       CALL QTPUT1 (A$ + " upload to "+DEFAULT.EXTENSION$+".  Please wait...")
  290.       CALL READDIR (2,1)
  291.       IF EOF(2) THEN _
  292.          X$ = A$
  293.       GSR.ARA$(1) = FILE.NAME$
  294.       CALL BRKFNAME (FILE.NAME$,PRE$,BODY$,EXT$,TRUE)
  295.       FILE.NAME.HOLD$ = BODY$ + "." + DEFAULT.EXTENSION$
  296.       B$(0) = FILE.NAME$
  297.       FILE.NAME$ = PRE$ + FILE.NAME.HOLD$
  298.       CALL SHELLEXIT (X$ + " " + BODY$ + " " + NODE.ID$)
  299.       CALL FINDIT (FILE.NAME$)
  300.       IF NOT OK THEN _
  301.          FILE.NAME$ = GSR.ARA$(1) : _
  302.          CALL FINDIT (FILE.NAME$) : _
  303.          FILE.NAME.HOLD$ = BODY$ + EXT$ : _
  304.          IF OK THEN _
  305.             GOTO 20709
  306.       GOSUB 20736
  307. 20709 CALL QTPUT1 ("Upload successful")
  308.       X$ = DATE$
  309.       Z$ = LEFT$(X$,6) + _
  310.            RIGHT$(X$,2)
  311.       STREW.TO$ = ""
  312.       UCAT$ = ""
  313. 20710 CALL QTPUT1 ("Describe " + FILE.NAME.HOLD$ + _
  314.            " (Begin with '/' if for SYSOP only)")
  315.       CALL QTPUT1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  316.                  MAX.DESC.LEN - 4) + "..Max>")
  317.       CALL QTPUT ("? ",0)
  318.       A$ = ""
  319.       SUBROUTINE.PARAMETER = 1
  320.       PARSE.OFF = TRUE
  321.       CALL TGET
  322.       CALL CARRIER
  323.       IF SUBROUTINE.PARAMETER = -1 THEN _
  324.          B$ = "<description unavailable>": _
  325.          GOTO 20712
  326.       IF LEN(B$) > MAX.DESC.LEN OR LEN(B$) < 10 THEN _
  327.          CALL QTPUT1 ("10 chars min," + STR$(MAX.DESC.LEN) + " max") : _
  328.          GOTO 20710
  329. 20712 OK = 0
  330.       CALL CHECKNOVELL (OK)
  331.       IF OK <> -1 THEN _
  332.          CALL SETSHAREDATTR (FILE.NAME$, OK) : _
  333.          IF OK <> 0 THEN _
  334.             CALL PSCRN ("Error setting shared attribute")
  335.       DESC$ = B$
  336.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  337.          IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _
  338.             IF LEFT$(B$,1) = "/" THEN _
  339.                CALL UPDTCALR (B$,2) : _
  340.                GOTO 20726_
  341.             ELSE GOTO 20717
  342. 20715 IF LEFT$(B$,1) = "/" THEN _
  343.          UCAT$ = "***" : _
  344.          GOTO 20722
  345.       UCAT$ = DEFAULT.CATEGORY.CODE$
  346. 20717 IF SUBROUTINE.PARAMETER = -1 OR _
  347.          USER.SECURITY.LEVEL < SL.CATEGORIZE.UPLOADS THEN _
  348.          GOTO 20722
  349. 20719 CALL BUFFILE (UPCAT.HELP$,X)
  350. 20720 A$= "Upload best fits what category (D=default,H=help)"        ' KG072201
  351.       SUBROUTINE.PARAMETER = 1
  352.       CALL TGET
  353.       CALL ALLCAPS (B$(1))                                           ' KG072201
  354.       IF SUBROUTINE.PARAMETER = -1 OR B$(1) = "D" THEN _             ' KG072201
  355.          B$ = DEFAULT.CATEGORY.CODE$ : _
  356.          GOTO 20722
  357.       IF Q = 0 THEN _
  358.          GOTO 20719                                                  ' KG072201
  359.       IF B$(1) = "H" OR _
  360.          B$(1) = "*" OR _
  361.          B$(1) = "?" THEN _
  362.          GOTO 20719
  363.       CALL CHKNARY (B$(1),CATEGORY.NAME$(),NUM.CATEGORIES,FOUND)
  364.       IF FOUND > 0 THEN _
  365.          UCAT$ = CATEGORY.CODE$(FOUND) : _
  366.          IF LEN(UCAT$) > 0 AND LEN(UCAT$) < 4 AND INSTR(UCAT$,",") = 0 THEN _
  367.             GOTO 20722
  368.       UCAT$ = ""
  369.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  370.          STREW.TO$ = DIRECTORY.PATH$ + _
  371.                      B$(1) + _
  372.                      "." + _
  373.                      DIRECTORY.EXTENTION$ : _
  374.          CALL FINDIT (STREW.TO$) : _
  375.          IF OK THEN _                                                ' KG072201
  376.             GOTO 20722 _                                             ' KG072201
  377.          ELSE CALL WORDINFILE (UPCAT.HELP$,B$(1),OK) : _             ' KG072201
  378.               IF OK THEN _                                           ' KG072201
  379.                  GOTO 20722                                          ' KG072201
  380.       STREW.TO$ = ""                                                 ' KG072201
  381.       CALL QTPUT1 ("No such category " + B$(1))
  382.       GOTO 20719
  383. 20722 IF USER.SECURITY.LEVEL >= ASK.EXTENDED.DESC AND _
  384.          MAX.EXTENDED.LINES > 0 AND SUBROUTINE.PARAMETER <> -1 THEN _
  385.          A$ = "Add an EXTENDED DESCRIPTION of " + _
  386.               FILE.NAME.HOLD$ + " ([Y],N)" : _
  387.          TURBO.KEY = -TURBO.KEY.USER : _
  388.          SUBROUTINE.PARAMETER = 1 : _
  389.          CALL TGET : _
  390.          IF SUBROUTINE.PARAMETER <> -1 THEN _
  391.             IF NOT NO THEN _
  392.                GET.EXT.DESC = TRUE : _
  393.                EXIT SUB
  394. 20723 B$ = DESC$
  395.       X$ = DATE$
  396.       Z$ = LEFT$(X$,6) + _
  397.            RIGHT$(X$,2)
  398.       EN$ = STREW.TO$
  399.       GOSUB 20730
  400.       EN$ = ALWAYS.STREW.TO$
  401.       GOSUB 20730
  402. 20725 EN$ = UPLOAD.DIRECTORY$
  403.       GOSUB 20730
  404. 20726 DF$ = " >> uploaded << "
  405.       UPLOADS = UPLOADS + 1
  406.       GLOBAL.UPLOADS = GLOBAL.UPLOADS + 1
  407.       ULBYTES! = ULBYTES! + BYTES.IN.FILE#
  408.       GLOBAL.ULBYTES! = GLOBAL.ULBYTES! + BYTES.IN.FILE#
  409.       CALL MUZAK (7)
  410.       CALL TIMEREMAIN (TIME.REMAINING!)
  411.       TIME.CREDITS! = TIME.CREDITS! + X!
  412.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!
  413.       IF PRIVATE.DOOR THEN _
  414.          X! = (X! - Q!) / 60.0 _
  415.       ELSE X! = (X! - TCA! + Q!)/60.0
  416.       X$ = STR$(FIX(X!*10.0))
  417.       X$ = LEFT$(X$,LEN(X$)-1) + "." + RIGHT$(X$,1)
  418.       IF X! > 1.0 THEN _
  419.          CALL QTPUT1 ("Uploads are appreciated here.  For today your") : _
  420.          CALL QTPUT1 ("SESSION & DAILY time limits increased by"+X$+" minutes")
  421.       GET.EXT.DESC = FALSE
  422.       EXIT SUB
  423. 20730 '          ---[ lock file ]---
  424.       IF EN$ = "" THEN _
  425.          RETURN
  426.       FMS.FORMAT = FALSE
  427.       IF EN$ = FMS.DIRECTORY$ OR LIMIT.SEARCH.TO.FMS THEN _
  428.          FMS.FORMAT = TRUE _
  429.       ELSE CALL FINDIT (EN$) : _
  430.            IF OK THEN _
  431.               CALL READDIR (2,1) : _
  432.               IF EC = 0 THEN _
  433.                  FMS.FORMAT = (LEFT$(A$,4) = "\FMS")
  434.       IF NOT FMS.FORMAT THEN _
  435.          READ.BACKWARDS = FALSE : _
  436.          FIXED.LEN = 0 : _
  437.          B$ = DESC$ _
  438.       ELSE FIXED.LEN = 34 + MAX.DESC.LEN : _
  439.            B$ = DESC$ + _
  440.                 SPACE$(MAX.DESC.LEN - LEN(DESC$)) + _
  441.                 UCAT$ + _
  442.                 SPACE$(3 - LEN(UCAT$)) : _
  443.            READ.BACKWARDS = TRUE : _
  444.            CALL FINDIT (EN$) : _
  445.            IF OK THEN _
  446.               CALL READDIR (2,1) : _
  447.               IF EC = 0 THEN _
  448.                  READ.BACKWARDS = (INSTR(A$," TOP ") = 0)
  449.       CALL LOCKAPPND
  450.       IF EC <> 0 THEN _
  451.          GOTO  20731
  452.       '          ---[ append ]---
  453.       IF GET.EXT.DESC THEN _
  454.          IF READ.BACKWARDS THEN _
  455.             FOR I = LINES.IN.DESC TO 1 STEP -1 : _
  456.                GOSUB 20732 : _
  457.             NEXT
  458.       PRINT #2,USING "\           \########  &  &"; _
  459.                      FILE.NAME.HOLD$; _
  460.                      BYTES.IN.FILE#; _
  461.                      Z$; _
  462.                      B$
  463.       IF GET.EXT.DESC THEN _
  464.          IF NOT READ.BACKWARDS THEN _
  465.             FOR I = 1 TO LINES.IN.DESC : _
  466.                GOSUB 20732 : _
  467.             NEXT
  468. 20731 CALL UNLKAPPND
  469.       FIXED.LEN = 0
  470.       RETURN
  471. 20732 X$ = A$(I)
  472.       CALL TRIM (X$)
  473.       IF X$ = "" THEN _
  474.          RETURN
  475.       IF NOT FMS.FORMAT THEN _
  476.          PRINT #2,"  ";A$(I) : _
  477.          RETURN
  478.       IF FIXED.LEN > LEN(A$(I)) THEN _
  479.          X$ = SPACE$(FIXED.LEN - 1 - LEN(A$(I))) + "." _
  480.       ELSE X$ = ""
  481.       PRINT #2, "  ";LEFT$(A$(I),FIXED.LEN);X$
  482.       RETURN
  483. 20734 CALL FINDIT (FILE.NAME$)
  484. 20736 IF NOT OK THEN _
  485.          BYTES.IN.FILE# = 0.0_
  486.       ELSE BYTES.IN.FILE# = LOF(2)
  487.       IF BYTES.IN.FILE# < 2.0 THEN _
  488.          EXIT SUB
  489.       RETURN
  490.       END SUB
  491. 20741 ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  492. ' $PAGE
  493. '
  494. '  NAME    -- BADFILE
  495. '
  496. '  INPUTS  --     PARAMETER                    MEANING
  497. '               VIOLATION$
  498. '               VIOLATIONS.THIS.SESSION
  499. '               FILNAME$                      NAME OF FILE
  500. '
  501. '  OUTPUTS -- RESULT                      1 = FILE NAME IS OK
  502. '                                         2 = CHARACTER NOT ALLOWED
  503. '                                         3 = SYSTEM CRASH ATTEMPT
  504. '             VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  505. '             FILNAME$                    Gets capitalized
  506. '
  507. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  508. '             to either crash the system or to breach RBBS-PC's security.
  509. '
  510.       SUB BADFILE (FILNAME$,RESULT) STATIC
  511. '
  512. '
  513. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  514. '
  515. '
  516.       RESULT = 2
  517.       IF LEN(FILNAME$) < 1 THEN _
  518.          EXIT SUB
  519.       CALL BADFILECHAR (FILNAME$,OK)
  520.       IF NOT OK THEN _
  521.          EXIT SUB
  522.       IF RIGHT$(FILNAME$,1) = "." THEN _
  523.            EXIT SUB
  524.       CALL ALLCAPS (FILNAME$)
  525.       XX = INSTR(FILNAME$,".")
  526.       IF XX > 0 THEN _
  527.          XX = INSTR(XX + 1,FILNAME$,".") : _
  528.          IF XX > 0 THEN _
  529.             EXIT SUB
  530.       XX = LEN(FILNAME$)
  531.       IF XX => 3 THEN _
  532.          IF INSTR("PRN:CON:AUX:NUL:",FILNAME$) THEN _
  533.             GOTO 20742
  534.       IF XX => 4 THEN _
  535.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FILNAME$) THEN _
  536.             GOTO 20742
  537.       CALL BRKFNAME (FILNAME$,PRE$,BODY$,EXT$,FALSE)
  538.       IF LEN(PRE$) > 64 OR LEN(BODY$) > 8 OR LEN(BODY$) < 1 OR LEN(EXT$) > 3 THEN _
  539.          EXIT SUB
  540.       XX = LEN(BODY$)
  541.       IF XX => 3 THEN _
  542.          IF INSTR("PRN:CON:AUX:NUL:",BODY$) THEN _
  543.             GOTO 20742
  544.       IF XX => 4 THEN _
  545.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",BODY$) THEN _
  546.             GOTO 20742
  547.       RESULT = 1
  548.       EXIT SUB
  549. 20742 VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS
  550.       VIOLATION$ = VIOLATION$ + _
  551.                    FILNAME$
  552.       RESULT = 3
  553.       END SUB
  554. '
  555. 21105 ' $SUBTITLE: 'LIBRARY - sub to support Library downloads'
  556. ' $PAGE
  557. '
  558. '  NAME    -- LIBRARY
  559. '
  560. '  INPUTS  --     PARAMETER                    MEANING
  561. '              SUBROUTINE.PARAMETER     1 = DISPLAY ACTIVE AREA
  562. '                                       2 = CHANGE ACTIVE AREA
  563. '                                       3 = DISPLAY PC-SIG
  564. '                                           DISCLAIMER
  565. '                                       4 = ARCHIVE LIBRARY DISK
  566. '                                       5 = DOWNLOAD COMPLETED
  567. '              LIBRARY.TYPE             0 = NO LIBRARY ACTIVE
  568. '                                       1 = LIBRARY FROM PC-SIG
  569. '              LIBRARY.DRIVE$           LIBRARY DRIVE ID
  570. '
  571. '  OUTPUTS -- NONE
  572. '
  573. '  PURPOSE -- To provide access support for library drives
  574. '
  575.       SUB LIBRARY STATIC
  576.       STATIC LIBRARY.SUBDIR.NAME$(1)
  577.       STATIC DISK.TITLE$
  578.       EC = 0
  579.       IF LIBRARY.TYPE = 0 THEN _
  580.          EXIT SUB
  581.       IF LIBRARY.DISK.CHAR$ = "" THEN _
  582.          LIBRARY.DISK.CHAR$ = "0000"
  583.       ON SUBROUTINE.PARAMETER GOTO 21110, 21115, 21130, 21140, 21159
  584. 21110 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  585.          A$ = "No Library disk currently selected" _
  586.       ELSE A$ = "Library disk " + _
  587.                 LIBRARY.DISK.CHAR$ + _
  588.                 " selected - " + _
  589.                 DISK.TITLE$
  590.       CALL QTPUT1 (A$)
  591.       IF LIBRARY.DISK.ARCHIVE$ = "" THEN _
  592.          EXIT SUB
  593.       FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  594.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) <> "" THEN _
  595.             CALL QTPUT1 (LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) + _
  596.                        "." + DEFAULT.EXTENSION$ + " ready for transmission!")
  597.       NEXT
  598.       EXIT SUB
  599. 21115 IF Q = 1 THEN _
  600.          A$ = "Change Library disk from " + _
  601.               LIBRARY.DISK.CHAR$ + _
  602.               " to (1 -" + _
  603.               STR$(LIBRARY.MAX.DISK) + _
  604.               ")" : _
  605.          SUBROUTINE.PARAMETER = 1 : _
  606.          CALL TGET : _
  607.          IF SUBROUTINE.PARAMETER = -1 THEN _
  608.             EXIT SUB _
  609.          ELSE IF Q = 0 THEN _
  610.                  LIBRARY.DISK.CHAR$ = "0000" : _
  611.                  CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  612.                                   "\" : _
  613.                  GOTO 21126
  614. 21117 IF VAL(B$(Q)) < 1 OR VAL(B$(Q)) > LIBRARY.MAX.DISK THEN _
  615.          Q = 1 : _
  616.          GOTO 21115
  617. 21120 LIBRARY.DISK.CHAR$ = B$(Q)
  618.       CLOSE 2
  619.       LIBRARY.DISK.CHAR$ = RIGHT$("0000" + LIBRARY.DISK.CHAR$,4)
  620. 21121 CALL FINDIT("RBBS-CDR.DEF")
  621.       IF EC <> 0 THEN _
  622.          EXIT SUB
  623. 21122 IF EOF(2) THEN _
  624.          LIBRARY.DISK.CHAR$ = "" : _
  625.          EXIT SUB
  626.       INPUT #2,WORK.SUBDIR$,CHDIR.LIBRARY$
  627.       LINE INPUT #2,DISK.TITLE$
  628.       IF LIBRARY.DISK.CHAR$ = WORK.SUBDIR$ THEN _
  629.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  630.                           CHDIR.LIBRARY$ : _
  631.          GOTO 21126
  632.       GOTO 21122
  633. 21126 EC = 0
  634.       CALL CHANGEDIR (CHDIR.LIBRARY$)
  635.       IF EC <> 0 THEN _
  636.          LIBRARY.DISK.CHAR$ = "0000" : _
  637.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  638.                           "\" : _
  639.          GOTO 21126
  640.       EXIT SUB
  641. 21130 IF LIBRARY.TYPE <> 1 THEN _
  642.          EXIT SUB
  643.       CALL SKIPLINE(1)
  644.       A$ = "PC-SIG Library is being accessed.  The file that you are about"
  645.       CALL QTPUT1 (A$)
  646.       A$ = "to download can also be obtained by ordering DISK " + _
  647.            LIBRARY.DISK.CHAR$
  648.       CALL QTPUT1 (A$)
  649.       A$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  650.       CALL QTPUT (A$,2)
  651.       EXIT SUB
  652. 21140 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  653.          CALL QTPUT1 ("You must select a LIBRARY disk first!") : _
  654.          EXIT SUB
  655.       A$ = "Archive contents of Library disk - " + _
  656.            LIBRARY.DISK.CHAR$ + _
  657.            " for data transmission (Y/[N])"
  658.       SUBROUTINE.PARAMETER = 1
  659.       CALL TGET
  660.       IF NOT LOCAL.USER THEN _
  661.          IF SUBROUTINE.PARAMETER = -1 THEN _
  662.             EXIT SUB
  663.       IF NOT YES THEN _
  664.          EXIT SUB
  665. 21145 CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  666.                     LIBRARY.NODE.ID$ + _
  667.                     "DK*." + DEFAULT.EXTENSION$)
  668. 21150 CALL QTPUT1 ("Work/RAM disk has been purged")
  669.       CALL QTPUT1 ("Beginning archive using " + _
  670.                   LIBRARY.ARCHIVE.PROGRAM$ + _
  671.                   " Please be patient!")
  672.       REDIM LIBRARY.SUBDIR.NAME$(10)
  673.       LIBRARY.SUBDIR.CHAR$ = ""
  674.       LIBRARY.LOOP.COUNT = 0
  675.       GOSUB 21157
  676.       A$ = "Contents of Library disk - " + _
  677.            LIBRARY.DISK.CHAR$ + _
  678.            " now archived for data transmission"
  679.       CALL QTPUT1 (A$)
  680.       A$ = "Searching for Sub-directories"
  681.       CALL QTPUT1 (A$)
  682.       GOSUB 21158
  683.       LIBRARY.DISK.ARCHIVE$ = LIBRARY.DISK.CHAR$
  684. '
  685. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  686. '
  687.       TREEDIR$ = LIBRARY.WORK.DISK.PATH$ + _
  688.                  LIBRARY.NODE.ID$ + _
  689.                  "DKDIR.LST"
  690.       DIRCMD$ = "DIR " + _
  691.                 LIBRARY.DRIVE$ + _
  692.                 " | FIND " +  _
  693.                 CHR$(34) + _
  694.                 " <DIR> " + _
  695.                 CHR$(34) + _
  696.                 "  > " + _
  697.                 TREEDIR$
  698. 21151 SHELL DIRCMD$
  699.       CALL SKIPLINE (2)
  700.       LOCATE 24,1
  701.       EC = 0
  702. 21152 CLOSE 2
  703. 21153 CALL OPENWORK (2,TREEDIR$)
  704.       LIBRARY.SUBDIR.COUNT = 0
  705.       WHILE NOT EOF(2)
  706.          LINE INPUT #2, DIRREC$
  707.          IF LEFT$(DIRREC$,1) <> "." THEN _
  708.             LIBRARY.SUBDIR.COUNT = LIBRARY.SUBDIR.COUNT + 1 : _
  709.             LIBRARY.SUBDIR.NAME$(LIBRARY.SUBDIR.COUNT) = _
  710.             LEFT$(DIRREC$,8)
  711.       WEND
  712.       CLOSE 2
  713.       LIBRARY.LOOP.COUNT = 1
  714.       IF LIBRARY.SUBDIR.COUNT = 0 THEN _
  715.          GOTO 21156
  716.       A$ = "There are" + STR$(LIBRARY.SUBDIR.COUNT) + _
  717.            " Subdirectories on LIBRARY disk - " + _
  718.            LIBRARY.DISK.CHAR$
  719.       CALL QTPUT1 (A$)
  720.       FOR LIBRARY.LOOP.COUNT = 1 TO LIBRARY.SUBDIR.COUNT
  721.          IF NOT LOCAL.USER THEN _
  722.             CALL CARRIER : _
  723.             IF SUBROUTINE.PARAMETER THEN _
  724.                GOTO 21155
  725.          LIBRARY.SUBDIR.CHAR$ = MID$("ABCDEFGHI",LIBRARY.LOOP.COUNT,1)
  726.          A$ = "Creating " + _
  727.               LIBRARY.NODE.ID$ + _
  728.               "DK" + _
  729.               LIBRARY.DISK.CHAR$ + _
  730.               LIBRARY.SUBDIR.CHAR$ + _
  731.               ".ARC using " + LIBRARY.ARCHIVE.PROGRAM$
  732.          CALL QTPUT1 (A$)
  733.          CHDIR CHDIR.LIBRARY$ + _
  734.                "\" + _
  735.                LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT)
  736.          GOSUB 21157
  737.          A$ = "Disk - " + _
  738.               LIBRARY.DISK.CHAR$ + _
  739.               "; Subdirectory" + _
  740.               " -" + _
  741.               STR$(LIBRARY.LOOP.COUNT) + _
  742.               " has been archived for data transmission"
  743.          CALL QTPUT1 (A$)
  744.          GOSUB 21158
  745. 21155 NEXT LIBRARY.LOOP.COUNT
  746. 21156 CALL CARRIER
  747.       A$ = ""
  748.       EXIT SUB
  749. 21157 LIBRARY.ARCHIVE$ = LIBRARY.ARCHIVE.PATH$ + _
  750.                        LIBRARY.ARCHIVE.PROGRAM$ + _
  751.                        " " + _
  752.                        LIBRARY.WORK.DISK.PATH$ + _
  753.                        LIBRARY.NODE.ID$ + _
  754.                        "DK" + _
  755.                        LIBRARY.DISK.CHAR$ + _
  756.                        LIBRARY.SUBDIR.CHAR$ + _
  757.                        " " + _
  758.                        LIBRARY.DRIVE$ + _
  759.                        "*.*"
  760.       IF USE.DEVICE.DRIVER$ <> "" AND FOSSIL THEN _
  761.          LIBRARY.ARCHIVE$ = DISK.FOR.DOS$ + _
  762.                             "COMMAND /C " + _
  763.                             LIBRARY.ARCHIVE$ + _
  764.                             " > " + _
  765.                             USE.DEVICE.DRIVER$
  766.       SHELL LIBRARY.ARCHIVE$
  767.       CALL SKIPLINE (2)
  768.       LOCATE 24,1
  769.       RETURN
  770. 21158 LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT) = LIBRARY.NODE.ID$ + _
  771.                                              "DK" + _
  772.                                              LIBRARY.DISK.CHAR$ + _
  773.                                              LIBRARY.SUBDIR.CHAR$
  774.       RETURN
  775. 21159 FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  776.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = A$ THEN _
  777.             LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = ""
  778.       NEXT
  779.       END SUB
  780. 21598 ' $SUBTITLE: 'XFERTYPE - sub to identify file xfer protocol'
  781. ' $PAGE
  782. '
  783. '  NAME    -- XFERTYPE
  784. '
  785. '  INPUTS  --     PARAMETER                    MEANING
  786. '               A$
  787. '               B$(1)
  788. '               Q
  789. '               RELIABLE.MODE
  790. '               TRANSFER.OPTIONS$
  791. '               USER.TRANSFER.DEFAULT$
  792. '               XFER.SUPPORT
  793. '
  794. '  OUTPUTS   -- CHECKSUM
  795. '               FLEN
  796. '               FT$
  797. '
  798. '  PURPOSE -- To identify the file transfer protocol (either
  799. '             from the user's default or via explicit selection)
  800. '
  801.       SUB XFERTYPE(INDEX,SKIP.HELP) STATIC
  802.       IF TRANSFER.OPTIONS$ = "" OR USER.SECURITY.LEVEL <> PREV.USL THEN _
  803.          CALL PROTOCOL : _
  804.          PREV.USL = USER.SECURITY.LEVEL
  805.       X$ = A$ + "Protocol"
  806.       ON INDEX GOTO 21600,21620
  807. '
  808. '
  809. ' *  MANUAL SELECT OF TRANSFER PROTOCOL
  810. '
  811. '
  812. 21600 IF SKIP.HELP THEN _
  813.          GOTO 21604
  814. 21602 CALL BUFFILE (HELP.PATH$ + "UF" + HELP.EXTENSION$,X)
  815.       IF SUBROUTINE.PARAMETER = -1 THEN _
  816.          EXIT SUB
  817. 21604 CALL QTPUT1 (X$)
  818.       STOP.INTERRUPTS = TRUE
  819.       CALL BUFSTRNG (TRANSFER.OPTIONS$,4096,X)
  820.       CALL QTPUT (MID$("?!",1-TURBO.KEY.USER,1)+" ",0)
  821.       A$ = ""
  822.       TURBO.KEY = -TURBO.KEY.USER
  823.       SUBROUTINE.PARAMETER = 1
  824.       MACRO.MIN = 2
  825.       CALL TGET
  826.       IF SUBROUTINE.PARAMETER = -1 THEN _
  827.          EXIT SUB
  828.       IF Q = 0 THEN _
  829.          GOTO 21604
  830.       Z$ = B$(1)
  831. '
  832. '
  833. ' *  DEFAULT SELECT OF TRANSFER PROTOCOL
  834. '
  835. '
  836. 21610 CALL ALLCAPS (Z$)
  837.       IF INSTR("H?",Z$) > 0 THEN _
  838.          GOTO 21602
  839.       FF = INSTR(DFLTXFER$,Z$)
  840.       IF FF < 1 THEN _
  841.          GOTO 21600
  842. 21612 FT$ = MID$(DFLTXFER$,FF,1)
  843.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  844.       GOTO 21621
  845. 21620 FF = -1
  846.       IF COMMAND.TRANSFER$ <> "" THEN _
  847.          Z$ = COMMAND.TRANSFER$ : _
  848.          GOTO 21610
  849.       X = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  850.       IF X > 0 THEN _
  851.          IF MID$(INTERNAL.EQUIV$,X,1) <> "N" THEN _
  852.             Z$ = USER.TRANSFER.DEFAULT$ : _
  853.             GOTO 21610
  854.       PROTO.PROMPT$ = "None"
  855.       FF = 0
  856.       EXIT SUB
  857. 21621 IF FF = PREV.FF AND PREV.PROTO.DEF$ = PROTO.DEF$ THEN _
  858.          PROTO.PROMPT$ = PREV.PROTO.PROMPT$ : _
  859.          EXIT SUB
  860.       PREV.FF = FF
  861.       PREV.PROTO.DEF$ = PROTO.DEF$
  862.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  863.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  864.       CALL FINDIT (PROTO.DEF$)
  865.       IF OK THEN _
  866.          GOTO 21623
  867.       X = INSTR("AXCYN",INTERNAL.PROTO$)
  868.       IF X < 1 THEN _
  869.          INTERNAL.PROTO$ = "N"
  870.       PROTO.PROMPT$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",INTERNAL.PROTO$)-9,10)
  871.       CALL TRIMTRAIL (PROTO.PROMPT$," ")
  872.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  873.       FLEN = 128 - 896 * (INTERNAL.PROTO$ = "Y")
  874.       BLOCK.SIZE = FLEN
  875.       IF INTERNAL.PROTO$ = "Y" THEN _
  876.          SPEED.FACTOR! = 0.87 _
  877.       ELSE IF INTERNAL.PROTO$ = "A" THEN _
  878.          SPEED.FACTOR! = 0.92 _
  879.       ELSE SPEED.FACTOR! = 0.78
  880.       GOTO 21625
  881. 21623 CALL READPARMS (WORK.ARA$(),13,FF)
  882.       IF EC > 0 THEN _
  883.          FF = LEN(DFLTXFER$) : _
  884.          EXIT SUB
  885.       PROTO.PROMPT$ = WORK.ARA$(1)
  886.       IF LEN(PROTO.PROMPT$) > 2 THEN _
  887.          IF MID$(PROTO.PROMPT$,2,1) = ")" THEN _
  888.             PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,1) + MID$(PROTO.PROMPT$,3)
  889.       X = INSTR(PROTO.PROMPT$+CRLF$,CRLF$)
  890.       PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,X-1)
  891.       CALL TRIM (PROTO.PROMPT$)
  892.       PROTO.METHOD$ = LEFT$(WORK.ARA$(3),1)
  893.       CALL ALLCAPS (PROTO.METHOD$)
  894.       REQ.8.BIT = (LEFT$(WORK.ARA$(4),1) = "8")
  895.       DOWN.TEMPLATE$ = WORK.ARA$(12)
  896.       UP.TEMPLATE$ = WORK.ARA$(13)
  897.       X$ = WORK.ARA$(11)
  898.       X = INSTR(X$,"=")
  899.       ADVANCE.PROTO.WRITE = FALSE
  900.       IF X < 2 OR X >= LEN(X$) THEN _
  901.          FAILURE.PARM = 4 : _
  902.          FAILURE.STRING$ = "F" _
  903.       ELSE FAILURE.PARM = VAL(LEFT$(X$,X-1)) : _
  904.            FAILURE.STRING$ = MID$(X$,X+1) : _
  905.            X = INSTR(FAILURE.STRING$,"=") : _
  906.            IF X > 0 THEN _
  907.               ADVANCE.PROTO.WRITE = (MID$(FAILURE.STRING$,X) = "=A") : _
  908.               FAILURE.STRING$ = LEFT$(FAILURE.STRING$,X-1)
  909.       PROTO.MACRO$ = WORK.ARA$(10)
  910.       FAKE.XRPT = (LEFT$(WORK.ARA$(8),1) = "F")
  911.       BATCH.PROTO = (LEFT$(WORK.ARA$(6),1) = "B")
  912.       SPEED.FACTOR! = VAL(WORK.ARA$(9))
  913.       IF SPEED.FACTOR! < 0.1 THEN _
  914.          SPEED.FACTOR! = 0.87
  915.       BLOCK.SIZE = VAL(WORK.ARA$(7))
  916.       FLEN = BLOCK.SIZE
  917.       IF FLEN < 1 THEN _
  918.          FLEN = 128
  919. 21625 PREV.PROTO.PROMPT$ = PROTO.PROMPT$
  920.       END SUB
  921. 21993 ' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
  922. ' $PAGE
  923. '
  924. '  NAME    -- FILELOCK
  925. '
  926. '  INPUTS  --     PARAMETER                    MEANING
  927. '             SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
  928. '                                    2 FLUSH MESSAGE RECORD TO DISK
  929. '                                      AND UNLOCK MESSAGES
  930. '                                    3 LOCK MESSAGE FILE
  931. '                                    4 UNLOCK MESSAGE FILE
  932. '                                    5 LOCK USER FILE
  933. '                                    6 LOCK 4 RECORD BLOCK IN USER
  934. '                                      FILE
  935. '                                    7 UNLOCK USER FILE
  936. '                                    8 UNLOCK 4 RECORD BLOCK IN USER
  937. '                                      FILE
  938. '                                    9 LOCK UPLOAD DIRECTORY OR
  939. '                                      COMMENTS FILE
  940. '                                   10 UNLOCK UPLOAD DIRECTORY OR
  941. '                                      COMMENTS FILE
  942. '               ACTIVE.MESSAGE FILE$   NAME OF MESSAGE FILE
  943. '               ACTIVE.USER.FILE$      NAME OF USER FILE
  944. '               CONFIG.FILE.NAME$      FILE NAME TO FLUSH RECORD FROM
  945. '               EN$                    UPLOAD DIRECTORY OR COMMENTS
  946. '                                      FILE NAME TO LOCK/UNLOCK
  947. '               NETWORK.TYPE           TYPE OF NETWORK LOCKING TO USE
  948. '
  949. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
  950. '             BLK
  951. '             LOCK.DRIVE
  952. '             LOCK.FILE.NAME$
  953. '             LOCK.STATUS$
  954. '             MESSAGE.FILE.LOCK
  955. '             USER.BLOCK.LOCK
  956. '             USER.FILE.LOCK
  957. '             USER.FILE.INDEX
  958. '
  959. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  960. '             multiple copies of RBBS-PC are sharing the same
  961. '             files in either a multi-tasking DOS environment or
  962. '             in a local area network environment
  963. '
  964.       SUB FILELOCK STATIC
  965.       ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000, _
  966.                                     26500,27000,27500,29000,29500
  967.       EXIT SUB
  968. '
  969. '
  970. ' *  UNLOCK USERS AND MESSAGES
  971. '
  972. '
  973. 21995 GOSUB 27000
  974.       GOSUB 25000
  975.       RETURN
  976. '
  977. '
  978. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  979. '
  980. '
  981. 21996 CLOSE 1
  982.       IF SHARE.IT THEN _
  983.          OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
  984.       ELSE OPEN "I",1,CONFIG.FILENAME$
  985. '
  986. '
  987. ' *  UNLOCK MESSAGES
  988. '
  989. '
  990.       GOSUB 25000
  991.       CALL OPENMSG
  992.       RETURN
  993. '
  994. '
  995. ' *  LOCK MESSAGE FILE
  996. '
  997. '
  998. 22000 IF MESSAGE.FILE.LOCK = TRUE THEN _
  999.          RETURN
  1000.       MESSAGE.FILE.LOCK = TRUE
  1001.       MID$(LOCK.STATUS$,1,2) = "LM"
  1002.       SUBROUTINE.PARAMETER = 2
  1003.       CALL LINE25
  1004.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1005.       ON NETWORK.TYPE GOTO 22100,22200,22300,22400,22500,29700
  1006.       RETURN
  1007. '
  1008. '
  1009. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  1010. '
  1011. '
  1012. 22100 AX = &H0
  1013.       BX = &H1
  1014.       IF MULTI.LINK.PRESENT > 0 THEN _
  1015.          CALL RBBSML(AX,BX)
  1016.       RETURN
  1017. '
  1018. '
  1019. ' *  LOCK MESSAGE FILE (OMNINET)
  1020. '
  1021. '
  1022. 22200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1023.       CC$ = CHR$(1) + _
  1024.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1025.       GOSUB 28000
  1026.       IF CT = 0 THEN _
  1027.          RETURN
  1028.       CALL DELAYIT (1)
  1029.       GOTO 22200
  1030. '
  1031. '
  1032. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  1033. ' *  LOCK USER FILE (ORCHID PC-NET)
  1034. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)
  1035. '
  1036. '
  1037. 22300 GOSUB 28100
  1038.       CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1039.       RETURN
  1040. '
  1041. '
  1042. ' *  LOCK SYSTEM (DESQview)
  1043. '
  1044. '
  1045. 22400 CALL DVLOCK("MESSAGE")
  1046.       RETURN
  1047. '
  1048. '
  1049. ' *  LOCK MESSAGE FILE (10 NET)
  1050. ' *  LOCK USER FILE (10 NET)
  1051. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)
  1052. '
  1053. '
  1054. 22500 GOSUB 28100
  1055.       CALL LPLK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1056.       RETURN
  1057. '
  1058. '
  1059. ' *  UNLOCK MESSAGE FILE
  1060. '
  1061. '
  1062. 25000 IF NOT MESSAGE.FILE.LOCK THEN _
  1063.          RETURN
  1064.       MESSAGE.FILE.LOCK = FALSE
  1065.       MID$(LOCK.STATUS$,1,2) = "UM"
  1066.       SUBROUTINE.PARAMETER = 2
  1067.       CALL LINE25
  1068.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1069.       ON NETWORK.TYPE GOTO 25100,25200,25300,25400,25500,29800
  1070.       RETURN
  1071. '
  1072. '
  1073. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1074. '
  1075. '
  1076. 25100 AX = &H100
  1077.       BX = &H1
  1078.       IF MULTI.LINK.PRESENT > 0 THEN _
  1079.          CALL RBBSML(AX,BX)
  1080.       RETURN
  1081. '
  1082. '
  1083. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1084. '
  1085. '
  1086. 25200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1087.       CC$ = CHR$(17) + _
  1088.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1089.       GOSUB 28000
  1090.       IF CT = 128 THEN _
  1091.          RETURN
  1092.       CALL DELAYIT (1)
  1093.       GOTO 25200
  1094. '
  1095. '
  1096. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1097. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1098. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)
  1099. '
  1100. '
  1101. 25300 GOSUB 28100
  1102.       CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1103.       RETURN
  1104. '
  1105. '
  1106. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1107. '
  1108. '
  1109. 25400 CALL DVUNLOCK("MESSAGE")
  1110.       RETURN
  1111. '
  1112. '
  1113. ' *  UNLOCK MESSAGE FILE (10 NET)
  1114. ' *  UNLOCK USER FILE (10 NET)
  1115. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)
  1116. '
  1117. '
  1118. 25500 GOSUB 28100
  1119.       CALL UNLOK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1120.       RETURN
  1121.  
  1122. '
  1123. '
  1124. ' *  LOCK USER FILE
  1125. '
  1126. '
  1127. 26000 IF USER.FILE.LOCK = TRUE THEN _
  1128.          RETURN
  1129.       USER.FILE.LOCK = TRUE
  1130.       MID$(LOCK.STATUS$,4,2) = "LU"
  1131.       SUBROUTINE.PARAMETER = 2
  1132.       CALL LINE25
  1133.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1134.       ON NETWORK.TYPE GOTO 26100,26200,22300,26300,22500,29720
  1135.       RETURN
  1136. '
  1137. '
  1138. ' *  LOCK USER FILE (MULTI-LINK)
  1139. '
  1140. '
  1141. 26100 AX = &H0
  1142.       BX = &H2
  1143.       IF MULTI.LINK.PRESENT > 0 THEN _
  1144.          CALL RBBSML(AX,BX)
  1145.       RETURN
  1146. '
  1147. '
  1148. ' *  LOCK USER FILE (OMNINET)
  1149. '
  1150. '
  1151. 26200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1152.       CC$ = CHR$(1) + _
  1153.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1154.       GOSUB 28000
  1155.       IF CT = 0 THEN _
  1156.          RETURN
  1157.       CALL DELAYIT (1)
  1158.       GOTO 26200
  1159. '
  1160. '
  1161. ' *  LOCK USER FILE (DESQVIEW)
  1162. '
  1163. '
  1164. 26300 CALL DVLOCK("USER")
  1165.       RETURN
  1166. '
  1167. '
  1168. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1169. '
  1170. '
  1171. 26500 IF USER.BLOCK.LOCK = TRUE THEN _
  1172.          RETURN
  1173.       USER.BLOCK.LOCK = TRUE
  1174.       BLK = (USER.FILE.INDEX / 4) + .26
  1175.       MID$(LOCK.STATUS$,7,2) = "LB"
  1176.       SUBROUTINE.PARAMETER = 2
  1177.       CALL LINE25
  1178.       ON NETWORK.TYPE GOTO 26600,26700,26800,26750,26900,29730
  1179.       RETURN
  1180. '
  1181. '
  1182. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1183. '
  1184. '
  1185. 26600 AX = &H0
  1186.       BX = BLK + 10
  1187.       IF MULTI.LINK.PRESENT > 0 THEN _
  1188.          CALL RBBSML(AX,BX)
  1189.       RETURN
  1190. '
  1191. '
  1192. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1193. '
  1194. '
  1195. 26700 CC$ = CHR$(1) + _
  1196.             "BLK" + _
  1197.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1198.       GOSUB 28000
  1199.       IF CT = 0 THEN _
  1200.          RETURN
  1201.       CALL DELAYIT (1)
  1202.       GOTO 26700
  1203. '
  1204. '
  1205. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1206. '
  1207. '
  1208. 26750 CALL DVLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))
  1209.       RETURN
  1210. '
  1211. '
  1212. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1213. '
  1214. '
  1215. 26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1216.                         "BLK" + _
  1217.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1218.       GOTO 22300
  1219. '
  1220. '
  1221. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1222. '
  1223. '
  1224. 26900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1225.                         "BLK" + _
  1226.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1227.       GOTO 22500
  1228. '
  1229. '
  1230. ' *  UNLOCK USER FILE
  1231. '
  1232. '
  1233. 27000 IF NOT USER.FILE.LOCK THEN _
  1234.          RETURN
  1235.       USER.FILE.LOCK = FALSE
  1236.       MID$(LOCK.STATUS$,4,2) = "UU"
  1237.       SUBROUTINE.PARAMETER = 2
  1238.       CALL LINE25
  1239.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1240.       ON NETWORK.TYPE GOTO 27100,27200,25300,27300,25500,29820
  1241.       RETURN
  1242. '
  1243. '
  1244. ' *  UNLOCK USER FILE (MULTI-LINK)
  1245. '
  1246. '
  1247. 27100 AX = &H100
  1248.       BX = &H2
  1249.       IF MULTI.LINK.PRESENT > 0 THEN _
  1250.          CALL RBBSML(AX,BX)
  1251.       RETURN
  1252. '
  1253. '
  1254. ' *  UNLOCK USER FILE (OMNINET)
  1255. '
  1256. '
  1257. 27200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1258.       CC$ = CHR$(17) + _
  1259.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1260.       GOSUB 28000
  1261.       IF CT = 128 THEN _
  1262.          RETURN
  1263.       CALL DELAYIT (1)
  1264.       GOTO 27200
  1265. '
  1266. '
  1267. ' *  UNLOCK USER FILE (DESQVIEW)
  1268. '
  1269. '
  1270. 27300 CALL DVUNLOCK("USER")
  1271.       RETURN
  1272. '
  1273. '
  1274. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1275. '
  1276. '
  1277. 27500 IF NOT USER.BLOCK.LOCK THEN _
  1278.          RETURN
  1279.       USER.BLOCK.LOCK = FALSE
  1280.       BLK = (USER.FILE.INDEX / 4) + .26
  1281.       MID$(LOCK.STATUS$,7,2) = "UB"
  1282.       SUBROUTINE.PARAMETER = 2
  1283.       CALL LINE25
  1284.       ON NETWORK.TYPE GOTO 27600,27700,27800,27750,27900,29830
  1285.       RETURN
  1286. '
  1287. '
  1288. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1289. '
  1290. '
  1291. 27600 AX = &H100
  1292.       BX = BLK + 10
  1293.       IF MULTI.LINK.PRESENT > 0 THEN _
  1294.          CALL RBBSML(AX,BX)
  1295.       RETURN
  1296. '
  1297. '
  1298. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1299. '
  1300. '
  1301. 27700 CC$ = CHR$(17) + _
  1302.             "BLK" + _
  1303.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1304.       GOSUB 28000
  1305.       IF CT = 128 THEN _
  1306.          RETURN
  1307.       CALL DELAYIT (1)
  1308.       GOTO 27700
  1309. '
  1310. '
  1311. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1312. '
  1313. '
  1314. 27750 CALL DVUNLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))
  1315.       RETURN
  1316. '
  1317. '
  1318. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1319. '
  1320. '
  1321. 27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1322.                         "BLK" + _
  1323.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1324.       GOTO 25300
  1325. '
  1326. '
  1327. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1328. '
  1329. '
  1330. 27900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1331.                         "BLK" + _
  1332.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1333.       GOTO 25500
  1334. '
  1335. '
  1336. ' *  CORVUS OMNINET INTERFACE
  1337. '
  1338. '
  1339. 28000 CC$ = LINE.FEED$ + _
  1340.             CHR$(0) + _
  1341.             CHR$(11) + _
  1342.             CC$
  1343.       CALL CDSEND(CC$)
  1344.       CALL CDRECV(CN$)
  1345.       CT = ASC(MID$(CN$,3,1))
  1346.       IF CT => 128 THEN _
  1347.          CALL LPRNT("CORVUS LOCK FAIL",1) : _
  1348.          SUBROUTINE.PARAMETER = -1
  1349. 28010 CT = ASC(MID$(CN$,4,1))
  1350.       IF CT => 129 THEN _
  1351.          CALL LPRNT("CORVUS FULL",1) : _
  1352.          SUBROUTINE.PARAMETER = -1
  1353.       RETURN
  1354. '
  1355. '
  1356. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1357. '
  1358. '
  1359. 28100 CALL ALLCAPS (LOCK.FILE.NAME$)
  1360.       LOCK.DRIVE = ASC(LEFT$(LOCK.FILE.NAME$,1)) - ASC("A")
  1361.       LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
  1362.                         STRING$(32 - LEN(LOCK.FILE.NAME$),0)
  1363.       A = 0
  1364.       RETURN
  1365. '
  1366. '
  1367. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$
  1368. '
  1369. '
  1370. 29000 IF LOCKED.EN$ = EN$ THEN _
  1371.          RETURN
  1372.       LOCKED.EN$ = EN$
  1373.       MID$(LOCK.STATUS$,10,2) = "LD"
  1374.       SUBROUTINE.PARAMETER = 2
  1375.       CALL LINE25
  1376.       LOCK.FILE.NAME$ = EN$
  1377.       ON NETWORK.TYPE GOTO 29100,29010,22300,29300,22500,29710
  1378. 29010 RETURN
  1379. '
  1380. '
  1381. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)
  1382. '
  1383. '
  1384. 29100 AX = &H0
  1385.       BX = &H3
  1386.       IF MULTI.LINK.PRESENT > 0 THEN _
  1387.          CALL RBBSML(AX,BX)
  1388.       RETURN
  1389. '
  1390. '
  1391. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1392. '
  1393. '
  1394. 29300 CALL DVLOCK("MISC")
  1395.       RETURN
  1396. '
  1397. '
  1398. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$
  1399. '
  1400. '
  1401. 29500 IF LOCKED.EN$ <> EN$ THEN _
  1402.          RETURN
  1403.       LOCKED.EN$ = ""
  1404.       MID$(LOCK.STATUS$,10,2) = "UD"
  1405.       SUBROUTINE.PARAMETER = 2
  1406.       CALL LINE25
  1407.       LOCK.FILE.NAME$ = EN$
  1408.       ON NETWORK.TYPE GOTO 29600,29510,25300,29650,25500,29810
  1409. 29510 RETURN
  1410. '
  1411. '
  1412. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)
  1413. '
  1414. '
  1415. 29600 AX = &H100
  1416.       BX = &H3
  1417.       IF MULTI.LINK.PRESENT > 0 THEN _
  1418.          CALL RBBSML(AX,BX)
  1419.       EXIT SUB
  1420. '
  1421. '
  1422. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1423. '
  1424. '
  1425. 29650 CALL DVUNLOCK("MISC")
  1426.       RETURN
  1427. '
  1428. '
  1429. ' *  NETBIOS SEMAPHORE LOCK MECHANISM
  1430. ' *     Only the USERS file is actually locked.  All other files are locked
  1431. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1432. ' *     file semaphore as follows:
  1433. ' *        RECORD 1 = MESSAGES file lock status
  1434. ' *        RECORD 2 = Comments/Upload dir locked
  1435. ' *        RECORD 3 = entire USERS file lock
  1436. '
  1437. '
  1438. ' * Lock MESSAGES
  1439. 29700 CALL NETBIOS (1,6,1)
  1440.       RETURN
  1441.  
  1442. ' * Lock Comments/Upload dir
  1443. 29710 CALL NETBIOS (1,6,2)
  1444.       RETURN
  1445.  
  1446. ' * Lock USERS file
  1447. 29720 CALL NETBIOS (1,6,3)
  1448.       RETURN
  1449.  
  1450. ' * Lock single USERS record
  1451. 29730 CALL NETBIOS (1,6,3)
  1452.       RETURN
  1453.  
  1454. ' * UNLOCK MESSAGES
  1455. 29800 CALL NETBIOS (0,6,1)
  1456.       RETURN
  1457.  
  1458. ' * UNLOCK Comments/Upload dir
  1459. 29810 CALL NETBIOS (0,6,2)
  1460.       RETURN
  1461.  
  1462. ' * UNLOCK USERS file
  1463. 29820 CALL NETBIOS (0,6,3)
  1464.       RETURN
  1465.  
  1466. ' * UNLOCK single USERS record
  1467. 29830 CALL NETBIOS (0,6,3)
  1468.       RETURN
  1469.       END SUB
  1470. 30000 ' $SUBTITLE: 'INITIBM - sub to create/open NETBIOS semaphore file'
  1471. ' $PAGE
  1472. '
  1473. '  NAME    -- INITIBM   (Written by Doug Azzarito)
  1474. '
  1475. '  INPUTS  -- NONE
  1476. '
  1477. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1   ABORT RBBS
  1478. '
  1479. '  PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
  1480. '             Create file if it does not exits.
  1481. '
  1482.       SUB INITIBM STATIC
  1483. '
  1484. '
  1485. ' *  SEE IF FILE EXISTS
  1486. '
  1487. '
  1488.       SHARE.IT = TRUE
  1489.       FOR I = LEN(MAIN.MESSAGE.FILE$) TO 0 STEP -1
  1490.          IF I = 0 THEN _
  1491.             GOTO 30010
  1492.          IF MID$(MAIN.MESSAGE.FILE$,I,1) = ":" OR _
  1493.             MID$(MAIN.MESSAGE.FILE$,I,1) = "\" THEN _
  1494.             GOTO 30010
  1495.       NEXT
  1496. 30010 IBM.FLAG.FILE$ = LEFT$(MAIN.MESSAGE.FILE$,I) + _
  1497.                        "IBMFLAGS"
  1498.       CALL FINDIT (IBM.FLAG.FILE$)
  1499.       CLOSE 2
  1500.       IF OK THEN _
  1501.          GOTO 30020
  1502. '
  1503. '
  1504. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
  1505. '
  1506. '
  1507.       OPEN IBM.FLAG.FILE$ ACCESS WRITE AS #6 LEN=2
  1508.       FIELD 6, 2 AS LOCKBUF$
  1509.       LSET LOCKBUF$ = MKI$(0)
  1510.       FOR I = 1 TO 3
  1511.          PUT 6
  1512.       NEXT
  1513.       CLOSE #6
  1514. 30020 OPEN IBM.FLAG.FILE$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1515.       END SUB
  1516. 30500 ' $SUBTITLE: 'OPENMSG - open the MESSAGES file'
  1517. ' $PAGE
  1518. '
  1519. '  NAME    -- OPENMSG
  1520. '
  1521. '  INPUTS  --     PARAMETER                    MEANING
  1522. '              ACTIVE.MESSAGE.FILE$
  1523. '              SHARE.IT
  1524. '
  1525. '  OUTPUTS --  MESSAGE.RECORD$
  1526. '
  1527.       SUB OPENMSG STATIC
  1528. '
  1529. '
  1530. ' *  OPEN AND DEFINE MESSAGE FILE
  1531. '
  1532. '
  1533.      CLOSE 1
  1534.       IF SHARE.IT THEN _
  1535.          OPEN ACTIVE.MESSAGE.FILE$ ACCESS READ WRITE SHARED AS #1 _
  1536.       ELSE OPEN "R",1,ACTIVE.MESSAGE.FILE$
  1537.       FIELD 1,128 AS MESSAGE.RECORD$
  1538.       END SUB
  1539. 30595 ' $SUBTITLE: 'FINDFUNC - sub to handle local keyboard functions'
  1540. ' $PAGE
  1541. '
  1542. '  NAME    -- FINDFUNC
  1543. '
  1544. '  INPUTS  --  PARAMETER                 MEANING
  1545. '             ACTIVE.MENU$              INDICATOR OF ACTIVE MENU
  1546. '             ADJUSTED.SECURITY         SWITCH INDICATING TEMP. SECURITY CHANGE
  1547. '             AUTODOWNLOAD.DESIRED      USER'S PREFERENCE FOR AUTODOWNLOADING
  1548. '             CALLERS.FILE$             NAME OF CALLERS FILE
  1549. '             CHAT.AVAILABLE            TOGGLE INDICATING IF SYSOP WILL CHAT
  1550. '             CHECK.BULLETIN.LOGON      USER'S PREFERENCE FOR BULLETIN CHECK
  1551. '             CONFERENCE.MODE           INDICATOR THAT USER IS IN A CONFERENCE
  1552. '             CURSOR.LINE               LINE THAT THE CURSOR IS AT
  1553. '             CURSOR.ROW                ROW THAT THE CURSOR IS AT
  1554. '             DISK.FOR.DOS$             DISK TO LOAD COMMAND.COM FROM
  1555. '             DISKFULL.GO.OFFLINE       INDICATOR OF WHAT TO DO WHEN DISK FULL
  1556. '             EXIT.TO.DOORS             FLAG INDICATING EXITING TO DOORS
  1557. '             EXPERT.USER               FLAG FOR EXPERT/NOVICE USER MODE
  1558. '             FIRST.NAME$               LOGGED ON USER'S FIRST NAME
  1559. '             F1.KEY                    FUNCTION KEY ONE VALUE
  1560. '             F10.KEY                   FUNCTION KEY TEN VALUE
  1561. '             GR                        GRAPHICS PREFERENCE OF USER
  1562. '             LINE.FEEDS                SWTICH FOR USER'S LINE FEED PREFERENCE
  1563. '             LOCAL.USER                FLAG INDICATING USER IS LOCAL
  1564. '             MINIMUM.LOGON.SECURITY    MINIMUM SECURITY TO LOGON
  1565. '             MODEM.GO.OFFHOOK.COMMAND$ COMMAND TO TAKE MODEM OFF-HOOK
  1566. '             MODEM.INIT.BAUD$          BAUD TO INITIALIZE MODEM AT
  1567. '             NODE.ID$                  NODE IDENTIFIER
  1568. '             NODE.RECORD.INDEX         NODE RECORD INDEX FOR THIS NODE
  1569. '             NULLS                     SWITCH FOR USER'S PREFERENCE FOR NULLS
  1570. '             PRINTER                   TOGGLE INDICATING PRINTER IS AVAILABLE
  1571. '             PROMPT.BELL               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1572. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION 
  1573. '             SKIP.FILES.LOGON          USER'S LOGON NOTIFICIATION PREFERENCE
  1574. '             SNOOP                     TOGGLE INDICATING SNOOP STATUS
  1575. '             SUBROUTINE.PARAMETER      -8  = SYSOP'S OPTION 6 REMOTELY
  1576. '                                       -9  = GOT TO DOS
  1577. '                                       -10 = SYSOP GET'S SYSTEM NEXT
  1578. '             SYSOP                     INDICATOR THAT USER IS SYSOP
  1579. '             SYSOP.ANNOY               TOGGLE INDICATING SYSOP IS AVAILABLE
  1580. '             SYSOP.NEXT                TOGGLE SO SYSOP GETS SYSTEM NEXT
  1581. '             UPPER.CASE                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1582. '             USER.FILE.INDEX           INDEX INTO THE USER FILE FOR CALLER
  1583. '             USER.SECURITY.LEVEL       USER'S SECURITY LEVEL
  1584. '             USERT.TRANSFER.DEFAULT    USER'S FILE TRANSFER DEFAULT PREFERENCE
  1585. '
  1586. '  OUTPUTS --
  1587. '             ADJUSTED.SECURITY        SWITCH INDICATING TEMP. SECURITY CHANGE
  1588. '             CHAT.AVAILABLE           TOGGLE INDICATING IF SYSOP WILL CHAT
  1589. '             FUNCTION.KEY             VALUE 1 TO 10 CORRESPONDING TO
  1590. '                                      THE FUNCTION KEY THAT WAS PRESSED
  1591. '             KEY.PRESSED$             CHARACTER STRING GENERATED BY KEY
  1592. '             PRINTER                  TOGGEL INDICATING PRINTER IS AVAILABLE
  1593. '             SNOOP                    TOGGLE INDICATING SNOOP STATUS
  1594. '             SYSOP                    INDICATOR THAT USER IS SYSOP
  1595. '             SYSOP.ANNOY              TOGGLE INDICATING SYSOP IS AVAILABLE
  1596. '             SYSOP.NEXT               TOGGLE SO SYSOP GETS SYSTEM NEXT
  1597. '             SUBROUTINE.PARAMETER     -1 CARRIER LOST
  1598. '                                      -2 CHAT MODE ACTIVATED
  1599. '                                      -3 FORCE CALLER ON-LINE
  1600. '                                      -4 EXIT TO SYSTEM IMMEDIATELY
  1601. '                                      -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1602. '                                      -6 TELL USER ACCESS IS DENIED
  1603. '                                      -7 UPDATE CALLERS FILE AND DENY ACCESS
  1604. '             USER.SECURITY.LEVEL      USER'S SECURITY LEVEL
  1605. '
  1606. '  PURPOSE -- To determine if a function has been pressed on
  1607. '             the PC'S keyboard that is running RBBS-PC.
  1608. '
  1609.       SUB FINDFUNC STATIC
  1610.       LOOKUP = SUBROUTINE.PARAMETER
  1611.       IF SUBROUTINE.PARAMETER < -1 THEN _
  1612.          SUBROUTINE.PARAMETER = 0 : _
  1613.          IF LOOKUP = - 8 THEN _
  1614.             GOTO 33070 _
  1615.          ELSE IF LOOKUP = - 9 THEN _
  1616.                  GOTO 31000 _
  1617.               ELSE IF LOOKUP = - 10 THEN _
  1618.                       GOTO 33090
  1619. '
  1620. '
  1621. ' *  TEST FOR FUNCTION KEY PRESSED
  1622. '
  1623. '
  1624. 30600 IF KEYBOARD.STACK$ = "" THEN _
  1625.          KEY.PRESSED$ = INKEY$ _
  1626.       ELSE KEY.PRESSED$ = KEYBOARD.STACK$ : _
  1627.            KEYBOARD.STACK$ = ""
  1628.       FUNCTION.KEY = 0
  1629.       IF LEN(KEY.PRESSED$) <> 2 THEN _
  1630.          GOTO 33970
  1631.       KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
  1632.       IF LOCAL.USER AND NOT SYSOP THEN _                             ' RM060404
  1633.          KEY.PRESSED$ = "" : _
  1634.          GOTO 33970
  1635.       IF KEY.PRESSED => F1.KEY AND _
  1636.          KEY.PRESSED <= F10.KEY THEN _
  1637.              FUNCTION.KEY = KEY.PRESSED - 58 : _
  1638.              GOTO 30610
  1639.       IF KEY.PRESSED = 117 THEN _    'Ctrl-End
  1640.          FUNCTION.KEY = 11
  1641.       IF KEY.PRESSED = 73 THEN _     'PgUp
  1642.          FUNCTION.KEY = 12
  1643.       IF KEY.PRESSED = 72 THEN _     'up arrow
  1644.          FUNCTION.KEY = 13
  1645.       IF KEY.PRESSED = 80 THEN _     'Down arrow
  1646.          FUNCTION.KEY = 14
  1647.       IF KEY.PRESSED = 81 THEN _     'PgDn
  1648.          FUNCTION.KEY = 15
  1649.       IF KEY.PRESSED = 75 THEN _     'left arrow
  1650.          FUNCTION.KEY = 16
  1651.       IF KEY.PRESSED = 77 THEN _     'Right arrow
  1652.          FUNCTION.KEY = 17
  1653.       IF KEY.PRESSED = 141 THEN _    'CTRL-up arrow
  1654.          FUNCTION.KEY = 18
  1655.       IF KEY.PRESSED = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1656.          FUNCTION.KEY = 18
  1657.       IF KEY.PRESSED = 145 THEN _    'CTRL-down arrow
  1658.          FUNCTION.KEY = 19
  1659.       IF KEY.PRESSED = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1660.          FUNCTION.KEY = 19
  1661.       IF KEY.PRESSED = 115 THEN _    'CTRL-left arrow
  1662.          FUNCTION.KEY = 20
  1663.       IF KEY.PRESSED = 116 THEN _    'CTRL-right arrow
  1664.          FUNCTION.KEY = 21
  1665. 30610 KEY.PRESSED$ = ""
  1666.       IF FUNCTION.KEY < 1 OR FUNCTION.KEY > 21 THEN _
  1667.          GOTO 33970
  1668.       IF FUNCTION.KEY < 10 AND (FUNCTION.KEY <> 8) THEN _
  1669.          GOTO 30620
  1670.       IF TOGGLE.ONLY THEN _
  1671.          SUBROUTINE.PARAMETER = 1 : _
  1672.          GOTO 33970
  1673. 30620 ON FUNCTION.KEY GOTO  31000, _            '  1 =  F1
  1674.                             32000, _            '  2 =  F2
  1675.                             33000, _            '  3 =  F3
  1676.                             33040, _            '  4 =  F4
  1677.                             33060, _            '  5 =  F5
  1678.                             33070, _            '  6 =  F6
  1679.                             33090, _            '  7 =  F7
  1680.                             33110, _            '  8 =  F8
  1681.                             33130, _            '  9 =  F9
  1682.                             33150, _            ' 10 = F10
  1683.                             31398, _            ' 11 = CTRL END
  1684.                             33200, _            ' 12 = PGUP
  1685.                             33170, _            ' 13 = UP ARROW
  1686.                             33180, _            ' 14 = DOWN ARROW
  1687.                             33220, _            ' 15 = PGDN
  1688.                             33240, _            ' 16 = LEFT ARROW
  1689.                             33250, _            ' 17 = RIGHT ARROW
  1690.                             33170, _            ' 18 = CTRL-UP ARROW
  1691.                             33180, _            ' 19 = CTRL-DOWN
  1692.                             33245, _            ' 20 = CTRL-LEFT
  1693.                             33255               ' 21 = CTRL-RIGHT
  1694. '
  1695. '
  1696. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
  1697. '
  1698. '
  1699. 31000 SUBROUTINE.PARAMETER = -10
  1700.       CALL CARRIER
  1701.       IF SUBROUTINE.PARAMETER = 0 THEN _
  1702.          GOTO 33970
  1703.       CALL BRKFNAME(CALLERS.FILE$,X$,Y$,Z$,TRUE)
  1704.       FILE.NAME$ = X$ + "RBBS" + NODE.FILE.ID$ + "F1.DEF"
  1705.       CLOSE 2
  1706.       CALL OPENOUTW (FILE.NAME$)
  1707.       PRINT #2,MID$(FILE.NAME$,3,7)
  1708.       IF EXIT.TO.DOORS THEN _
  1709.          SUBROUTINE.PARAMETER = -4 : _
  1710.          GOTO 33970
  1711.       CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  1712.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  1713.       CALL DELAYIT (2)
  1714.       SUBROUTINE.PARAMETER = -5
  1715.       GOTO 33970
  1716. '
  1717. '
  1718. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
  1719. '
  1720. '
  1721. 31398 IF NOT LOCAL.USER THEN _
  1722.          CALL CARRIER : _
  1723.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1724.             GOTO 33970
  1725.       FUNCTION.KEY = 0
  1726.       IF INSTR("MUF",ACTIVE.MENU$) > 0 THEN _
  1727.          GOTO 31399
  1728.       CURSOR.LINE = CSRLIN
  1729.       CURSOR.ROW = POS(0)
  1730.       LOCATE 25,1
  1731.       D$ = SPACE$(79)
  1732.       GOSUB 33210
  1733.       LOCATE 25,1
  1734.       D$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1735.       GOSUB 33210
  1736.       CALL DELAYIT (1)
  1737.       LOCATE CURSOR.LINE,CURSOR.ROW
  1738.       SUBROUTINE.PARAMETER = 1
  1739.       CALL LINE25
  1740.       GOTO 33970
  1741. 31399 CALL QTPUT1 (FIRST.NAME$ + ", goodbye and don't call back")
  1742.       IF USER.FILE.INDEX < 1 THEN _
  1743.          SUBROUTINE.PARAMETER = -6 : _
  1744.          GOTO 33970
  1745.       USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY - 1
  1746.       CALL DENYACCESS
  1747.       SUBROUTINE.PARAMETER = -7
  1748.       GOTO 33970
  1749. '
  1750. '
  1751. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1752. '
  1753. '
  1754.  
  1755. 32000 IF NOT LOCAL.USER THEN _
  1756.          CALL SKIPLINE (1) : _
  1757.          CALL QTPUT1 ("Sysop exiting to DOS. Please wait...") : _
  1758.          FUNCTION.KEY = 0 : _
  1759.          CALL DELAYIT (3)
  1760.       CALL SHELLEXIT (DISK.FOR.DOS$ + "COMMAND")                     ' KG052802
  1761.       'SHELL DISK.FOR.DOS$ + _
  1762.       '      "COMMAND"
  1763.       CLS
  1764.       IF NOT LOCAL.USER THEN _
  1765.          CALL CARRIER : _
  1766.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1767.             GOTO 33970
  1768.       SUBROUTINE.PARAMETER = 2
  1769.       CALL LINE25
  1770.       CALL QTPUT1 ("Sysop back from DOS.  Returning control to you.")
  1771.       COMMPORT.STACK$ = CARRIAGE.RETURN$
  1772.       GOTO 33970
  1773. '
  1774. '
  1775. ' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE)
  1776. '
  1777. '
  1778. 33000 PRINTER = NOT PRINTER
  1779.       CHANGE.VALUE = PRINTER
  1780.       FIELD.POSITION = 38
  1781.       GOTO 33950
  1782. '
  1783. '
  1784. ' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY)
  1785. '
  1786. '
  1787. 33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
  1788.       CHANGE.VALUE = SYSOP.ANNOY
  1789.       FIELD.POSITION = 34
  1790.       GOTO 33950
  1791. '
  1792. '
  1793. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
  1794. '
  1795. '
  1796. 33060 FUNCTION.KEY = 0
  1797.       SUBROUTINE.PARAMETER = -3
  1798.       GOTO 33970
  1799. '
  1800. '
  1801. ' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE)
  1802. ' *  6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE)
  1803. '
  1804. '
  1805. 33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
  1806.       CHANGE.VALUE = SYSOP.AVAILABLE
  1807.       FIELD.POSITION = 32
  1808.       GOTO 33950
  1809. '
  1810. '
  1811. ' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT)
  1812. '
  1813. '
  1814. 33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN _
  1815.          GOTO 33970
  1816.       SYSOP.NEXT = NOT SYSOP.NEXT
  1817.       CHANGE.VALUE = SYSOP.NEXT
  1818.       FIELD.POSITION = 36
  1819.       GOTO 33950
  1820. '
  1821. '
  1822. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY)
  1823. '
  1824. '
  1825. 33110 SYSOP = NOT SYSOP
  1826.       CURSOR.LINE = CSRLIN
  1827.       CURSOR.ROW = POS(0)
  1828.       LOCATE 25,1
  1829.       D$ = SPACE$(79)
  1830.       NUM.RETURNS = 0
  1831.       CALL LPRNT (D$,NUM.RETURNS)
  1832.       LOCATE 25,1
  1833.       USER.SECURITY.LEVEL = (1 + SYSOP) * _
  1834.                             USER.SECURITY.SAVE  - _
  1835.                             SYSOP * _
  1836.                             SYSOP.SECURITY.LEVEL
  1837.       D$ = "SYSOP Privileges " + FNOFFON$(SYSOP)
  1838.       CALL LPRNT (D$,NUM.RETURNS)
  1839.       CALL DELAYIT (3)
  1840.       LOCATE CURSOR.LINE,CURSOR.ROW
  1841.       SUBROUTINE.PARAMETER = 1
  1842.       CALL LINE25
  1843.       CALL CALLOPT
  1844.       GOTO 33970
  1845. '
  1846. '
  1847. ' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE)
  1848. '
  1849. '
  1850. 33130 IF NOT SNOOP THEN _
  1851.          SNOOP = TRUE : _
  1852.          LOCATE 24,1,0 : _
  1853.          D$ = "SNOOP ON" : _
  1854.          NUM.RETURNS = 0 : _
  1855.          CALL LPRNT (D$,NUM.RETURNS) : _
  1856.          SUBROUTINE.PARAMETER = 2 : _
  1857.          CALL LINE25 _
  1858.       ELSE LOCATE ,,0 : _
  1859.            SNOOP = FALSE : _
  1860.            CLS
  1861. 33140 CHANGE.VALUE = SNOOP
  1862.       FIELD.POSITION = 58
  1863.       GOTO 33950
  1864. '
  1865. '
  1866. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
  1867. '
  1868. '
  1869. 33150 GOTO 33160
  1870. 33155 SUBROUTINE.PARAMETER = 1
  1871.       CALL LINE25
  1872.       GOTO 33970
  1873. 33160 CALL UPDTCALR ("Sysop began chat",1)
  1874.       PAGE.STATUS$ = ""
  1875.       CALL SKIPLINE (1)
  1876.       CALL QTPUT1 ("Hi " + _
  1877.            FIRST.NAME$ + _
  1878.            ", this is " + _
  1879.            SYSOP.FIRST.NAME$ + _
  1880.            " " + _
  1881.            SYSOP.LAST.NAME$ + _
  1882.            "  Sorry to break in to CHAT but..")
  1883.       CALL SYSOPCHAT
  1884.       COMMPORT.STACK$ = CHR$(13)
  1885.       GOTO 33155
  1886. '
  1887. '
  1888. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1889. '
  1890. '
  1891. 33170 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  1892.                             1 - 4 * (FUNCTION.KEY = 18)
  1893.       GOTO 33190
  1894. '
  1895. '
  1896. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1897. '
  1898. '
  1899. 33180 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  1900.                             1 + 4 * (FUNCTION.KEY = 19)
  1901. 33190 ADJUSTED.SECURITY = TRUE
  1902.       USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  1903.       IF (NOT CONFERENCE.MODE) AND (NOT SUB.BOARD) THEN _            ' KG052104
  1904.          ORIG.SECURITY = USER.SECURITY.LEVEL : _                     ' KG052104
  1905.       SUBROUTINE.PARAMETER = 2
  1906.       CALL LINE25
  1907.       CALL CALLOPT
  1908.       GOTO 33970
  1909. '
  1910. '
  1911. ' * PGUP DISPLAY USER PROFILE
  1912. '
  1913. '
  1914. 33200 IF NOT LOCAL.USER THEN _
  1915.          CALL CARRIER : _
  1916.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1917.             GOTO 33970
  1918.       IF VOICE.TYPE <> 0 THEN _
  1919.          TALK.ALL = TRUE
  1920.       CALL PAGEUP
  1921.       D$ = MID$("NoviceExPERT",1 -6 * EXPERT.USER,6)
  1922.       GOSUB 33210
  1923.       D$ = "GRAPHICS: " + _
  1924.            MID$("None AsciiColor",GR * 5 + 1,5)
  1925.       GOSUB 33210
  1926.       D$ = "PROTOCOL : " + _
  1927.            USER.TRANSFER.DEFAULT$
  1928.       GOSUB 33210
  1929.       D$ = "UPPER CASE " + _
  1930.            MID$("and lowerONLY", 1 - 9 * UPPER.CASE,9)
  1931.       GOSUB 33210
  1932.       D$ = "Line Feeds " + FNOFFON$(LINE.FEEDS)
  1933.       GOSUB 33210
  1934.       D$ = "Nulls " + FNOFFON$(NULLS)
  1935.       GOSUB 33210
  1936.       D$ = "Prompt Bell " + FNOFFON$(PROMPT.BELL)
  1937.       GOSUB 33210
  1938.       D$ = MID$("SKIP CHECK",1 -5 * CHECK.BULLETIN.LOGON,5) + _
  1939.            " old BULLETINS on logon."
  1940.       GOSUB 33210
  1941.       D$ = MID$("CHECKSKIP ",1 -5 * SKIP.FILES.LOGON,5) + _
  1942.            " new files on logon."
  1943.       GOSUB 33210
  1944.       D$ = "Autodownload " + FNOFFON$(AUTODOWNLOAD.DESIRED)
  1945.       GOSUB 33210
  1946.       TALK.ALL = FALSE
  1947.       GOTO 33970
  1948. 33210 NUM.RETURNS = 1
  1949.       CALL LPRNT(D$,NUM.RETURNS)
  1950.       RETURN
  1951. '
  1952. '
  1953. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE
  1954. '
  1955. '
  1956. 33220 IF NOT LOCAL.USER THEN _
  1957.          CALL CARRIER : _
  1958.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1959.             GOTO 33970
  1960.       CLS
  1961.       GOTO 33155
  1962. '
  1963. '
  1964. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1965. '
  1966. '
  1967. 33240 IF SECONDS.PER.SESSION! > 120 THEN _
  1968.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 60
  1969.       GOTO 33970
  1970. '
  1971. '
  1972. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  1973. '
  1974. '
  1975. 33245 IF SECONDS.PER.SESSION! > 360 THEN _
  1976.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 300
  1977.       GOTO 33970
  1978. '
  1979. '
  1980. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1981. '
  1982. '
  1983. 33250 IF SECONDS.PER.SESSION! < 86280 THEN _
  1984.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 60
  1985.       TIME.LOCK.SET = 0
  1986.       GOTO 33970
  1987. '
  1988. '
  1989. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  1990. '
  1991. '
  1992. 33255 IF SECONDS.PER.SESSION! < 86040 THEN _
  1993.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 300
  1994.       TIME.LOCK.SET = 0
  1995.       GOTO 33970
  1996. '
  1997. '
  1998. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
  1999. '
  2000. '
  2001. 33950 IF SNOOP THEN _
  2002.          SUBROUTINE.PARAMETER = 1 : _
  2003.          CALL LINE25
  2004. 33960 IF CONFERENCE.MODE = TRUE THEN _
  2005.          IF LOCAL.USER THEN _
  2006.             GOTO 33970 _
  2007.          ELSE D$ = "Cannot change status during Conference!" : _
  2008.               GOSUB 33210 : _
  2009.               GOTO 33970
  2010.       SUBROUTINE.PARAMETER = 3
  2011.       CALL FILELOCK
  2012.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2013.          GOTO 33970
  2014.       CALL OPENMSG
  2015.       FIELD 1,128 AS MESSAGE.RECORD$
  2016.       GET 1,NODE.RECORD.INDEX
  2017.       MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE)
  2018.       CALL SAVEPROF (2)
  2019.       FIELD 1, 128 AS MESSAGE.RECORD$
  2020. 33970 END SUB
  2021. 33990 ' $SUBTITLE: 'PAGEUP - Display user profile to SYSOP'
  2022. ' $PAGE
  2023. '
  2024. '  NAME    -- PAGEUP
  2025. '
  2026. '  INPUTS  --     PARAMETER                    MEANING
  2027. '             ACTIVE.USER.NAME$         CURRENT USER NAME
  2028. '             DOWNLOADS                 # OF FILES DOWNLOADED
  2029. '             EXPIRATION.DATE$          REGISTRATION EXPIRATION
  2030. '             LAST.DATE.TIME.ON.SAVE$   LAST DATE & TIME ON SYSTEM
  2031. '             LAST.MESSAGE.READ         LAST MESSAGE READ BY USER
  2032. '             PASSWORD.SAVE$            USERS PASSWORD
  2033. '             TIMES.LOGGED.ON           TIMES USER HAS LOGGED ON
  2034. '             UPLOADS                   # OF FILES UPLOADED
  2035. '             USER.SECURITY.SAVE        USERS SECURITY LEVEL
  2036. '
  2037. '  OUTPUTS -- MESSAGE.RECORD$
  2038. '
  2039.       SUB PAGEUP STATIC
  2040.       CALL LPRNT (" ",1)
  2041.       CALL LPRNT ("USER NAME : " + ACTIVE.USER.NAME$,1)
  2042.       CALL LPRNT ("SECURITY  :" + STR$(USER.SECURITY.SAVE),1)
  2043.       CALL LPRNT ("PASSWORD  :" + PASSWORD.SAVE$,1)
  2044.       CALL LPRNT ("READ MSG. :" + STR$(LAST.MESSAGE.READ),1)
  2045.       CALL LPRNT ("TIMES ON  :" + STR$(TIMES.LOGGED.ON),1)
  2046.       CALL LPRNT ("LAST ON   :" + LAST.DATE.TIME.ON.SAVE$,1)
  2047.       CALL LPRNT ("DOWNLOADS :" + STR$(DOWNLOADS),1)
  2048.       CALL LPRNT ("UPLOADS   :" + STR$(UPLOADS),1)
  2049.       IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  2050.          CALL LPRNT ("DL-BYTES  :" + STR$(DLBYTES!),1) : _
  2051.          CALL LPRNT ("UL-BYTES  :" + STR$(ULBYTES!),1)
  2052.       IF RESTRICT.BY.DATE THEN _
  2053.          CALL LPRNT ("EXPIRATION: " + EXPIRATION.DATE$,1)
  2054.       CALL LPRNT ("User's Profile",1)
  2055.       END SUB
  2056. 41008 ' $SUBTITLE: 'CHKTREMAIN - Kicks off if no time remaining'
  2057. ' $PAGE
  2058. '
  2059. '  NAME    -- CHKTREMAIN
  2060. '
  2061. '  INPUTS  --     PARAMETER                    MEANING
  2062. '                 TIME.LEFT!
  2063. '  OUTPUTS --     PARAMETER                    MEANING
  2064. '                 TIME.LEFT!      TIME IN MINUTES LEFT IN SESSION
  2065. '                 TCA!            TIME USED IN SECONDS
  2066. '                 SUBROUTINE.PARAMETER   -1 if no time left
  2067. '
  2068.       SUB CHKTREMAIN (TIME.LEFT!) STATIC
  2069.       CALL TIMEREMAIN (TIME.LEFT!)
  2070.       IF BYPASS.TIME.CHECK THEN _
  2071.          EXIT SUB
  2072.       IF TIME.LEFT! < 0.1 THEN _
  2073.          SUBROUTINE.PARAMETER = -1
  2074.       END SUB
  2075. 41010 ' $SUBTITLE: 'TIMEREMAIN - calculates time remaining in a session'
  2076. ' $PAGE
  2077. '
  2078. '  NAME    -- TIMEREMAIN
  2079. '
  2080. '  INPUTS  --     PARAMETER                    MEANING
  2081. '              USER.LOGON.TIME!
  2082. '              SECONDS.PER.SESSION!
  2083. '              BYPASS.TIME.CHECK
  2084. '  OUTPUTS --
  2085. '              TIME.REMAINING!       TIME IN MINUTES LEFT IN SESSION
  2086. '              TCA!                  TIME USED IN SECONDS
  2087. '
  2088.       SUB TIMEREMAIN (TIME.REMAINING!) STATIC
  2089.       TOA! = FRE("A")
  2090.       IF BYPASS.TIME.CHECK THEN _
  2091.          TIME.REMAINING! = SECONDS.PER.SESSION! /60 : _
  2092.          EXIT SUB
  2093.       CALL FINDTIME (TI!)
  2094.       ROLLOVER = FALSE
  2095.       IF TI! > USER.LOGON.TIME! THEN _
  2096.          TCA! = TI! - USER.LOGON.TIME! : _
  2097.          GOTO 41020
  2098.       ROLLOVER = TRUE
  2099.       TCA! = TI! + 86400! - USER.LOGON.TIME!
  2100. 41020 IF TIME.TO.DROP.TO.DOS! = 0 OR _
  2101.          OLD.DAT$ = DATE$ THEN _
  2102.          GOTO 41030
  2103.       IF NOT ROLLOVER AND _
  2104.          USER.LOGON.TIME! + SECONDS.PER.SESSION! => TIME.TO.DROP.TO.DOS! THEN _
  2105.          SECONDS.PER.SESSION! = (TIME.TO.DROP.TO.DOS! - USER.LOGON.TIME!) : _
  2106.          SHORTENED = TRUE
  2107.       IF ROLLOVER AND _
  2108.          USER.LOGON.TIME! + SECONDS.PER.SESSION! - 86400 => TIME.TO.DROP.TO.DOS! THEN _
  2109.          SECONDS.PER.SESSION! = TIME.TO.DROP.TO.DOS! : _
  2110.          SHORTENED = TRUE
  2111.       IF SHORTENED AND NOT TOLD.SHORT THEN _
  2112.          TOLD.SHORT = TRUE : _
  2113.          A$ = "Time shortened for scheduled event" : _
  2114.          CALL RINGCALLER
  2115. 41030 TIME.REMAINING! = (SECONDS.PER.SESSION!-TCA!) / 60
  2116.       TIME.REMAINING! = -(TIME.REMAINING! > 0.0)*TIME.REMAINING!
  2117.       END SUB
  2118. 41032 ' $SUBTITLE: 'DISPLAYTR - Display users time remaining'
  2119. ' $PAGE
  2120. '
  2121. '  NAME    -- DISPLAYTR
  2122. '
  2123. '  INPUTS  --     PARAMETER                    MEANING
  2124. '              TIME.REMAINING!
  2125. '
  2126. '  OUTPUTS --     PARAMETER                    MEANING
  2127. '              TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2128. '
  2129.       SUB DISPLAYTR (TIME.REMAINING!) STATIC
  2130.       CALL TIMEREMAIN (TIME.REMAINING!)
  2131.       CALL QTPUT1 (STR$(INT(TIME.REMAINING!)) + " min left")
  2132.       END SUB
  2133. 41498 ' $SUBTITLE: 'AMORPMTD - give time of day in AM/PM format'
  2134. ' $PAGE
  2135. '
  2136. '  NAME    -- AMORPMTD
  2137. '
  2138. '  INPUTS  --     PARAMETER                    MEANING
  2139. '
  2140. '  OUTPUTS -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  2141. '             TIM$                    CURRENT TIME (I.E. 1:13 PM)
  2142. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  2143. '
  2144. '  PURPOSE -- To set the time and date and
  2145. '             describe the time as "AM" or "PM."
  2146. '
  2147.       SUB AMORPMTD STATIC                                            ' KG061203
  2148. '
  2149. '
  2150. ' *  CALCULATE CURRENT TIME FOR AM OR PM
  2151. '
  2152. '
  2153. 41500 TIME.LOGGED.ON$ = TIME$
  2154.       CURRENT.DATE$ = DATE$
  2155.       CURRENT.DATE$ = LEFT$(CURRENT.DATE$ ,6) + _
  2156.                       RIGHT$(CURRENT.DATE$ ,2)
  2157.       CALL AMORPM                                                    ' KG061203
  2158.       END SUB
  2159.       SUB AMORPM STATIC                                              ' KG061203
  2160. 41510 TIM$ = TIME$
  2161.       IF VAL(MID$(TIM$,1,2)) = 12 THEN _
  2162.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
  2163.          TIM$ = LEFT$(TIM$,5) + _
  2164.                 " PM" : _
  2165.          EXIT SUB
  2166.       IF VAL(MID$(TIM$,1,2)) > 11 THEN _
  2167.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
  2168.          TIM$ = LEFT$(TIM$,5) + _
  2169.                 " PM" : _
  2170.          EXIT SUB
  2171.       TIM$ = LEFT$(TIM$,5) + _
  2172.              " AM"
  2173.       END SUB                                                        ' KG061203
  2174. 42000 ' $SUBTITLE: 'CARRIER - sub to monitor carrier on comm. port'
  2175. ' $PAGE
  2176. '
  2177. '  NAME    -- CARRIER
  2178. '
  2179. '  INPUTS  --     PARAMETER                    MEANING
  2180. '              LOCAL.USER = 0               REMOTE USER
  2181. '              LOCAL.USER = -1              LOCAL KEYBOARD USER
  2182. '              MODEM.STATUS.REGISTER        ADDRESS OF THE COMMUNI-
  2183. '                                           CATIONS PORT'S REGISTER
  2184. '              SUBROUTINE.PARAMETER = -9    DON'T WRITE TO CALLERS
  2185. '              SUBROUTINE.PARAMETER = -10   SAME AS -9, BUT DON'T
  2186. '                                           DELAY
  2187. '
  2188. '  OUTPUTS --  SUBROUTINE.PARAMETER = 0     CARRIER STILL PRESENT
  2189. '              SUBROUTINE.PARAMETER = -1    CARRIER NOT PRESENT
  2190. '
  2191. '  PURPOSE --  To test if carrier is present (i.e. the user
  2192. '              is still on line).
  2193. '
  2194.       SUB CARRIER STATIC
  2195.       IF AUTO.LOGOFF THEN _                                          ' KG061203
  2196.          SUBROUTINE.PARAMETER = -1 : _                               ' KG061203
  2197.          EXIT SUB                                                    ' KG061203
  2198.       CALL CHKCARRIER                                                ' KG061203
  2199.       END SUB                                                        ' KG061203
  2200.       SUB CHKCARRIER STATIC                                          ' KG061203
  2201.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2202.          EXIT SUB
  2203.       SPEEDY = SUBROUTINE.PARAMETER
  2204.       SUBROUTINE.PARAMETER = 0
  2205. '
  2206. '
  2207. ' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT)
  2208. '
  2209. '
  2210.       IF LOCAL.USER THEN _
  2211.          EXIT SUB
  2212.       IF FOSSIL THEN _
  2213.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2214.          STATUS% = STATUS% AND &H0080 : _
  2215.          IF STATUS% = &H0080 THEN _
  2216.             EXIT SUB _
  2217.          ELSE GOTO 42015
  2218. 42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2219.          EXIT SUB
  2220. '
  2221. '
  2222. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER
  2223. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER,
  2224. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
  2225. '
  2226. '
  2227. 42015 IF SPEEDY = -10 THEN _
  2228.          GOTO 42020
  2229.       CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  2230.       IF FOSSIL THEN _
  2231.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2232.          STATUS% = STATUS% AND &H0080 : _
  2233.          IF STATUS% = &H0080 THEN _
  2234.             EXIT SUB
  2235.       IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2236.          EXIT SUB
  2237. 42020 SUBROUTINE.PARAMETER = -1
  2238.       IF SPEEDY < -8 THEN _
  2239.          EXIT SUB
  2240.       IF ALREADY.WRITTEN = -9 THEN _
  2241.          EXIT SUB
  2242.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2243.       CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2244.       MODEM.OFFHOOK = -1
  2245.       ALREADY.WRITTEN = -9
  2246.       CALL UPDTCALR ("Carrier dropped",1)
  2247.       END SUB
  2248. 43004 ' $SUBTITLE: 'ASKGRAPH -- sub to ask users graphic preference'
  2249. ' $PAGE
  2250. '
  2251. '  NAME    -- ASKGRAPH
  2252. '
  2253. '  INPUTS  --    PARAMETER                    MEANING
  2254. '                UGD$                         USER GRAPHIC DEFAULT
  2255. '
  2256. '  OUTPUTS --
  2257. '
  2258. '  PURPOSE --  To determine users graphics default
  2259. '
  2260.       SUB ASKGRAPH (UGD$) STATIC
  2261.       IF EXPERT.USER THEN _
  2262.          GOTO 43007
  2263. 43006 FILE.NAME$ = HELP$(9)
  2264.       CALL BUFFILE (FILE.NAME$,X)
  2265.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2266.          EXIT SUB
  2267. 43007 CALL QTPUT1 ("GRAPHICS for text files and menus")
  2268.       A$ = "Change from " + MID$("NAC",GR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + PRESS.ENTER.EXPERT$
  2269.       SUBROUTINE.PARAMETER = 1
  2270.       TURBO.KEY = -TURBO.KEY.USER
  2271.       CALL TGET
  2272.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2273.          EXIT SUB
  2274.       IF Q = 0 THEN _
  2275.          CALL QTPUT1 ("Unchanged") : _
  2276.          EXIT SUB
  2277.       CALL ALLCAPS (B$(1))
  2278.       GR = INSTR("NAC",B$(1))
  2279.       IF GR = 2 AND NOT EIGHT.BIT THEN _
  2280.          CALL QTPUT1 ("Ascii unavailable.  Requires 8 bit") : _
  2281.          GOTO 43007
  2282.       IF GR = 0 THEN _
  2283.          GOTO 43006
  2284.       GR = GR - 1
  2285.       CALL SETUGD (GR,UGD$)
  2286.       END SUB
  2287. '
  2288. 43031 ' $SUBTITLE: 'GRAPHIC - sub to find graphic version of a file'
  2289. ' $PAGE
  2290. '
  2291. '  NAME    -- GRAPHIC
  2292. '
  2293. '  INPUTS  --     PARAMETER                    MEANING
  2294. '                 DEFAULT$          USERS GRAPHIC DEFAULT
  2295. '                 GR                WHETHER GRAPHICS ARE AVAILABLE
  2296. '                 FILNAME$          FILE TO CHECK
  2297. '
  2298. '  OUTPUTS --     FILNAME$          SUBSTITUTES NAME OF GRAPHICS
  2299. '                                   FILE (IF IT EXISTS).
  2300. '
  2301. '  PURPOSE -- Checks whether there is a graphics version of
  2302. '             a file, based on users graphics perference.
  2303. '             Sets file name to graphcis file if it exists,
  2304. '             Otherwise leaves file name intact.  Returns file
  2305. '             name to use.
  2306. '
  2307.       SUB GRAPHICX (DEFAULT$,FILNAME$,FILNUM) STATIC                 ' KG061001
  2308.       OK = FALSE
  2309.       IF GR THEN _
  2310.          CALL BRKFNAME (FILNAME$,DR$,X$,EXTENTION$,TRUE) : _
  2311.          IF LEN(X$) < 8 THEN _
  2312.             DF$ = DR$ + _
  2313.                   X$ + _
  2314.                   DEFAULT$ + _
  2315.                   EXTENTION$ : _
  2316.              CALL FINDITX (DF$,FILNUM) : _                           ' KG061001
  2317.              IF OK THEN _
  2318.                 FILNAME$ = DF$ : _
  2319.                 IF DEFAULT$ = "C" THEN _
  2320.                    LINES.PRINTED = 0
  2321.       IF NOT OK THEN _
  2322.          CALL FINDITX (FILNAME$,FILNUM)                              ' KG061001
  2323.       END SUB
  2324.       SUB GRAPHIC (DEFAULT$,FILNAME$) STATIC                         ' KG061001
  2325.       CALL GRAPHICX (DEFAULT$,FILNAME$,2)                            ' KG061001
  2326.       END SUB
  2327. 43068 ' $SUBTITLE: 'SAVEPROF - subroutine to read a user profile'
  2328. ' $PAGE
  2329. '
  2330. '  NAME    -- SAVEPROF
  2331. '
  2332. '  INPUTS  --     PARAMETER                    MEANING
  2333. '              BPS
  2334. '              EIGHT.BIT
  2335. '              EXIT.TO.DOORS
  2336. '              GR
  2337. '              MESSAGE.RECORD$
  2338. '              NODE.RECORD.INDEX
  2339. '              SYSOP
  2340. '              UPPER.CASE
  2341. '              TIME.LOGGED.ON$
  2342. '              PRIVATE.DOOR
  2343. '              RELIABLE.MODE
  2344. '
  2345. '  OUTPUTS -- NONE
  2346. '
  2347. '  PURPOSE -- Saves a user's options and communications parameters
  2348. '             in the node record when a user exits to a "door" so
  2349. '             that he is in the same status as when he exited.
  2350. '
  2351.       SUB SAVEPROF(IPARM) STATIC
  2352.       ON IPARM GOTO 43070,43080                                      ' KG072501
  2353. 43070 ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2354.       SUBROUTINE.PARAMETER = 3
  2355.       CALL FILELOCK
  2356.       CALL OPENMSG
  2357.       FIELD 1, 128 AS MESSAGE.RECORD$
  2358.       GET 1,NODE.RECORD.INDEX
  2359.       IF GLOBAL.SYSOP THEN _
  2360.          MID$(MESSAGE.RECORD$,1,30) = "SYSOP" + SPACE$(25)
  2361.       MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
  2362.       MID$(MESSAGE.RECORD$,42,2) = STR$(EIGHT.BIT)
  2363.       MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
  2364.       MID$(MESSAGE.RECORD$,46,2) = STR$(UPPER.CASE)
  2365.       MID$(MESSAGE.RECORD$,48,5) = MKS$(NUM.DWN.BYTS!) + MID$(STR$(-BATCH.TRANSFER),2)
  2366.       MID$(MESSAGE.RECORD$,53,2) = STR$(GR)
  2367.       MID$(MESSAGE.RECORD$,55,2) = STR$(SYSOP)
  2368.       MID$(MESSAGE.RECORD$,65,3) = CHR$(VAL(LEFT$(TIME.LOGGED.ON$,2))) + _
  2369.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,4,2))) + _
  2370.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,7,2)))
  2371.       MID$(MESSAGE.RECORD$,72,2) = STR$(PRIVATE.DOOR)
  2372.       MID$(MESSAGE.RECORD$,74,1) = MID$(STR$(TRANSFER.FUNCTION),2,1)
  2373.       MID$(MESSAGE.RECORD$,75,1) = FT$
  2374.       MID$(MESSAGE.RECORD$,76,2) = MKI$(CINT(TIME.CREDITS!)/60)      ' KG072501
  2375.       MID$(MESSAGE.RECORD$,79,8) = LEFT$(DOORED.TO$+"        ",8)
  2376.       MID$(MESSAGE.RECORD$,91,2) = STR$(RELIABLE.MODE)
  2377.       CALL BRKFNAME (CURRENT.PUI$,A$,B$,Z$,FALSE)
  2378.       MID$(MESSAGE.RECORD$,93,8) = B$ + SPACE$(8 - LEN(B$))
  2379.       MID$(MESSAGE.RECORD$,101,2) = STR$(LOCAL.USER)
  2380.       MID$(MESSAGE.RECORD$,103,2) = STR$(LOCAL.USER.MODE)
  2381.       GRN$ = LEFT$(GRN$,INSTR(GRN$ + " "," ") - 1)
  2382.       MID$(MESSAGE.RECORD$,105,8) = GRN$ + SPACE$(8 - LEN(GRN$))
  2383.       MID$(MESSAGE.RECORD$,117,2) = STR$(MENU.INDEX)
  2384.       MID$(MESSAGE.RECORD$,119,2) = LEFT$(DATE$,2)
  2385.       MID$(MESSAGE.RECORD$,121,2) = MID$(DATE$,4,2)
  2386.       MID$(MESSAGE.RECORD$,123,2) = RIGHT$(DATE$,2)
  2387.       MID$(MESSAGE.RECORD$,125,2) = LEFT$(TIME$,2)
  2388.       MID$(MESSAGE.RECORD$,127,2) = MID$(TIME$,4,2)
  2389. 43080 PUT 1,NODE.RECORD.INDEX
  2390.       SUBROUTINE.PARAMETER = 2
  2391.       CALL FILELOCK
  2392.       CALL OPENMSG
  2393.       END SUB
  2394. 44000 ' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
  2395. ' $PAGE
  2396. '
  2397. '  NAME    -- READPROF
  2398. '
  2399. '  INPUTS  --     PARAMETER                    MEANING
  2400. '              NODE.RECORD.INDEX     NODE RECORD TO USE
  2401. '              SYSOP.PASSWORD.1$     SYSOP'S PSEUDONYM 1
  2402. '              SYSOP.PASSWORD.2$     SYSOP'S PSEUDONYM 2
  2403. '
  2404. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2405. '             UPON EXITING RBBS-PC TO A "DOOR"
  2406. '
  2407. '  PURPOSE -- Reset a user's options and communications parameters
  2408. '             that were saved in the node record when a user exited
  2409. '             to a "door" so that he is in the same status as when
  2410. '             he exited.
  2411. '
  2412.       SUB READPROF STATIC                                            ' KG072501
  2413.       LOCATE 24,1
  2414.       CALL LPRNT("NODE INDEX" + STR$(NODE.RECORD.INDEX),1)
  2415.       FIELD 1, 128 AS MESSAGE.RECORD$
  2416.       GET 1,NODE.RECORD.INDEX
  2417.       RELIABLE.MODE = VAL(MID$(MESSAGE.RECORD$,91,2))
  2418.       MID$(MESSAGE.RECORD$,40,2) = "00"
  2419.       EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  2420.       BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  2421.       CALL COMMINFO
  2422.       BAUD.TEST = VAL(MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5))
  2423.       UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
  2424.       NUM.DWN.BYTS! = CVS(MID$(MESSAGE.RECORD$,48,4))
  2425.       BATCH.TRANSFER = (MID$(MESSAGE.RECORD$,52,1) = "1")
  2426.       GR = VAL(MID$(MESSAGE.RECORD$,53,2))
  2427.       HOUR.LOGGED.ON$ = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,65,1))),2),2)  ' KP061804
  2428.       MIN.LOGGED.ON$  = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,66,1))),2),2)  ' KP061804
  2429.       SEC.LOGGED.ON$  = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,67,1))),2),2)  ' KP061804
  2430.       TIME.LOGGED.ON$ = HOUR.LOGGED.ON$ + _                                          ' KP061804
  2431.                         ":" + _                                                      ' KP061804
  2432.                         MIN.LOGGED.ON$ + _                                           ' KP061804
  2433.                         ":" + _                                                      ' KP061804
  2434.                         SEC.LOGGED.ON$                                               ' KP061804
  2435.       TRANSFER.FUNCTION = VAL(MID$(MESSAGE.RECORD$,74,1))
  2436.       FT$ = MID$(MESSAGE.RECORD$,75,1)
  2437.       TIME.CREDITS! = 60*CVI(MID$(MESSAGE.RECORD$,76,2))             ' KG072501
  2438.       DOORED.TO$ = MID$(MESSAGE.RECORD$,79,8)
  2439.       CALL TRIM (DOORED.TO$)
  2440.       IF EXIT.TO.DOORS AND DOORED.TO$ <> "" THEN _
  2441.          CALL OPENWORK (2,DOORS.DEF$) : _
  2442.          IF EC = 0 THEN _
  2443.             CALL READPARMS (A$(),8,1) : _
  2444.             WHILE EC = 0 AND A$(1) <> DOORED.TO$ : _
  2445.                CALL READPARMS (A$(),8,1) : _
  2446.             WEND : _
  2447.             IF A$(1) = DOORED.TO$ THEN _
  2448.                DOOR.SKIPS.PASSWORD = TRUE : _
  2449.                CALL BUFFILE (A$(7),X)
  2450.       EC = 0
  2451.       MENU.INDEX = VAL(MID$(MESSAGE.RECORD$,117,2))
  2452.       CURRENT.PUI$ = MID$(MESSAGE.RECORD$,93,8)
  2453.       CALL REMOVE (CURRENT.PUI$," ")
  2454.       IF CURRENT.PUI$ <> "" THEN _
  2455.          CALL BRKFNAME (MAIN.PUI$,A$,B$,Z$,TRUE) : _
  2456.          CURRENT.PUI$ = A$ + CURRENT.PUI$ + Z$
  2457.       CUSTOM.PUI = (CURRENT.PUI$ <> "")
  2458.       LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))
  2459.       LOCAL.USER.MODE = VAL(MID$(MESSAGE.RECORD$,103,2))
  2460.       HOME.CONFERENCE$ = MID$(MESSAGE.RECORD$,105,8)
  2461.       CALL TRIM (HOME.CONFERENCE$)
  2462.       IF REQUIRED.RINGS > 0 AND _
  2463.          INSTR(MODEM.INIT.COMMAND$,"S0=255") THEN _
  2464.          COLOR 7,0,0 _
  2465.       ELSE COLOR FG,BG,BORDER
  2466.       IF LOCAL.USER.MODE THEN _
  2467.          GOTO 44003
  2468.       CALL SETBAUD
  2469. 44003 USER.LOGON.TIME! = VAL(HOUR.LOGGED.ON$) * 3600 + _             ' KP061804
  2470.                          VAL(MIN.LOGGED.ON$) * 60 + _                ' KP061804
  2471.                          VAL(SEC.LOGGED.ON$)                         ' KP061804
  2472.       HOUR.LOGGED.ON$ = ""                                           ' KP061804
  2473.       MIN.LOGGED.ON$ = ""                                            ' KP061804
  2474.       SEC.LOGGED.ON$ = ""                                            ' KP061804
  2475.       IF MINUTES.PER.SESSION! < 1 THEN _
  2476.          MINUTES.PER.SESSION! = 3
  2477.       IF NOT EIGHT.BIT THEN _
  2478.          OUT LINE.CONTROL.REGISTER,&H1A
  2479.       IF LEFT$(MESSAGE.RECORD$,7) = "SYSOP  " THEN _
  2480.          ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2481.       ELSE FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ") : _
  2482.            LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$ + " ","  ") : _
  2483.            FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1) : _
  2484.            LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END - (FIRST.NAME.END + 1)) : _
  2485.            ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
  2486.       Z$ = FIRST.NAME$
  2487.       END SUB
  2488. 44020 ' $SUBTITLE: 'COMMINFO - sub for variable of users baud/parity'
  2489. ' $PAGE
  2490. '
  2491. '  NAME    -- COMMINFO
  2492. '
  2493. '  INPUTS  --     PARAMETER                    MEANING
  2494. '                 BPS               BAUD RATE INDICATOR
  2495. '                 EIGHT.BIT           INDICATE FOR N/8/1
  2496. '
  2497. '  OUTPUTS -- BAUD.PARITY$
  2498. '
  2499. '  PURPOSE -- Create a string that shows a users baud rate and parity
  2500. '
  2501.       SUB COMMINFO STATIC
  2502. '
  2503. '
  2504. ' *  DETERMINE BAUD AND PARITY
  2505. '
  2506. '
  2507.   IF RELIABLE.MODE THEN _
  2508.      RELIABLE.MODE$ = "-R," _
  2509.   ELSE RELIABLE.MODE$ = ","
  2510.   BAUD.PARITY$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5) + _
  2511.                  " BAUD" + _
  2512.                  RELIABLE.MODE$ + _
  2513.                  MID$("N,8,1E,7,1",6 + 5 * EIGHT.BIT,5)
  2514.   BAUD.TEST = VAL(BAUD.PARITY$)
  2515.   END SUB
  2516. 50495 ' $SUBTITLE: 'DELAYIT - sub to wait number of seconds specified'
  2517. ' $PAGE
  2518. '
  2519. '  NAME    -- DELAYIT
  2520. '
  2521. '  INPUTS  --     PARAMETER                    MEANING
  2522. '                 DELAY.TIME           NUMBER OF SECONDS TO DELAY
  2523. '                                      (0 TO 3,600)
  2524. '
  2525. '  OUTPUTS -- NONE
  2526. '
  2527. '  PURPOSE -- To wait the number of seconds indicated before
  2528. '             returning control to the calling routine.
  2529. '
  2530.       SUB DELAYIT (DELAY.TIME) STATIC
  2531.       IF DELAY.TIME < 1 THEN _
  2532.          EXIT SUB
  2533.       CALL FINDTIME (DELAY!)
  2534.       DELAY! = DELAY.TIME + DELAY!
  2535.       IF DELAY! < 86400! THEN _
  2536.          GOTO 50520
  2537. 50500 CALL FINDTIME (TI!)
  2538.       IF TI! > DELAY.TIME THEN _  ' IF SECONDS TO DELAY IS PAST
  2539.          GOTO 50500              ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
  2540.       DELAY! = DELAY! - 86400!   ' TO PAST MIDNIGHT AND ADJUST THE DELAY
  2541. 50520 CALL FINDTIME (TI!)
  2542.       IF TI! < DELAY! THEN _
  2543.          GOTO 50520
  2544.       END SUB
  2545. 52070 ' $SUBTITLE: 'MODEMPUT - sub to write modem commands to modem'
  2546. ' $PAGE
  2547. '
  2548. '  SUBROUTINE NAME    -- MODEMPUT
  2549. '
  2550. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2551. '                        STRNG$                    MODEM COMMAND
  2552. '                        COMMANDS.BETWEEN.RINGS    INDICATOR TO WAIT FOR
  2553. '                                                  MODEM TO STOP RINGING
  2554. '                                                  BEFORE ISSUING COMMANDS
  2555. '                        DUMB.MODEM                INDICATOR THAT MODEM WOULD
  2556. '                                                  NOT UNDERSTAND COMMANDS
  2557. '
  2558. '  OUTPUT PARAMETERS  -- NONE
  2559. '
  2560. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2561. '
  2562.       SUB MODEMPUT (STRNG$) STATIC
  2563. '
  2564. '
  2565. ' *  SEND MODEM COMMAND
  2566. '
  2567. '
  2568.       IF DUMB.MODEM THEN _
  2569.          EXIT SUB
  2570.       IF NOT COMMANDS.BETWEEN.RINGS OR _
  2571.          NOT (INP(MODEM.STATUS.REGISTER) AND &H40) THEN _
  2572.          GOTO 52080
  2573.       CALL SETABORT (CONNECT.DELAY!,7)
  2574. 52072 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 THEN _
  2575.          CALL FINDTIME (TI!) : _
  2576.          IF TI! > CONNECT.DELAY! OR _
  2577.             (ABS(CONNECT.DELAY! - TI!) > 30 AND _
  2578.              (TI! + 86400 > CONNECT.DELAY!)) THEN _
  2579.             GOTO 52080
  2580.       GOTO 52072
  2581. 52080 CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2582.       CALL COMMPUT (STRNG$)
  2583.       END SUB
  2584. 57001 ' $SUBTITLE: 'DISPCALL - subroutine to display callers file'
  2585. ' $PAGE
  2586. '
  2587. '  NAME    -- DISPCALL
  2588. '
  2589. '  INPUTS  --     PARAMETER           MEANING
  2590. '
  2591. '  OUTPUTS --  (NONE)
  2592. '
  2593. '  PURPOSE -- Displays callers file to sysops and callers
  2594. '
  2595.       SUB DISPCALL STATIC
  2596.       IF CALLERS.FILE.PREFIX$ = "" THEN _
  2597.          EXIT SUB
  2598.       CALL SKIPLINE (1)
  2599.       CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX!
  2600.       CLOSE 4
  2601.       IF SHARE.IT THEN _
  2602.          OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _
  2603.       ELSE OPEN "R",4,CALLERS.FILE$,64
  2604.       FIELD 4,64 AS CALLERS.RECORD$
  2605. 57005 IF CALLERS.FILE.INDEX.TEMP! < 1 OR RET THEN _
  2606.          EXIT SUB
  2607. 57010 GET 4,CALLERS.FILE.INDEX.TEMP!
  2608.       A$ = CALLERS.RECORD$
  2609.       IF LEFT$(A$,3) = "   " OR _
  2610.          INSTR(A$,"on at") = 0 THEN _
  2611.          GOTO 57030
  2612. 57025 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! - 1
  2613.       GET 4,CALLERS.FILE.INDEX.TEMP!
  2614.       Z = INSTR(CALLERS.RECORD$,"{")
  2615.       IF Z < 1 OR Z > 15 THEN _
  2616.          Z = 15
  2617.       IF SYSOP OR _
  2618.          LEFT$(A$,3) <> "   " THEN _
  2619.          A$ = A$ + LEFT$(CALLERS.RECORD$,Z - 1)
  2620.       GOSUB 57100
  2621.       IF SYSOP THEN _
  2622.          A$ = MID$(CALLERS.RECORD$,Z) : _
  2623.          GOSUB 57100
  2624.       GOTO 57045
  2625. 57030 IF SYSOP THEN _
  2626.          GOSUB 57100
  2627. 57045 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! -1
  2628.       GOTO 57005
  2629. 57100 IF INSTR(A$,"LOGON DENIED") THEN _
  2630.          IF NOT SYSOP THEN _
  2631.             RETURN
  2632.       CALL QTPUT1 (A$)
  2633.       CALL ASKMORE ("",TRUE,TRUE,X,FALSE)
  2634.       IF NO OR SUBROUTINE.PARAMETER = -1 THEN _
  2635.          EXIT SUB
  2636.       RETURN
  2637.       END SUB
  2638. 58050 ' $SUBTITLE: 'FINDTIME - sub to calculate seconds since midnight'
  2639. ' $PAGE
  2640. '
  2641. '  NAME    -- FINDTIME
  2642. '
  2643. '  INPUTS  --     PARAMETER           MEANING
  2644. '               SECONDS!          VARIABLE TO RETURN RESULTS WITH
  2645. '
  2646. '  OUTPUTS --     SECONDS!          SECONDS SINCE MIDNIGHT
  2647. '
  2648. '  PURPOSE -- To calculate the number of seconds that elapsed since midnight
  2649. '
  2650.       SUB FINDTIME (SECONDS!) STATIC
  2651.       SECONDS! = TIMER
  2652.       END SUB
  2653. 58060 ' $SUBTITLE: 'ALLCAPS - sub to convert string to upper case'
  2654. ' $PAGE
  2655. '
  2656. '  NAME    -- ALLCAPS
  2657. '
  2658. '  INPUTS  --     PARAMETER           MEANING
  2659. '              CONVERT.FIELD$    STRING TO MAKE UPPER CASE
  2660. '
  2661. '  OUTPUTS --  CONVERT.FIELD$    CONVERTED STRINGS
  2662. '
  2663. '  PURPOSE -- Subroutine to convert a string to upper case
  2664. '
  2665.       SUB ALLCAPS (CONVERT.FIELD$) STATIC
  2666.       IF TURBO.RBBS THEN _
  2667.          CALL RBBSULC (CONVERT.FIELD$) : _
  2668.          EXIT SUB
  2669.       FOR Z = 1 TO LEN(CONVERT.FIELD$)
  2670.          IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
  2671.             MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
  2672.       NEXT
  2673.       END SUB
  2674. 58070 ' $SUBTITLE: 'CHECKTIM - sub to see if time has elasped'
  2675. ' $PAGE
  2676. '
  2677. '  NAME    -- CHECKTIM
  2678. '
  2679. '  INPUTS  --     PARAMETER           MEANING
  2680. '                 MAX.TIME!         NUMBER OF SECONDS PAST MIDNIGHT
  2681. '                                              NOT TO EXCEED
  2682. '
  2683. '  OUTPUTS -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
  2684. '                                      MAX.TIME!
  2685. '             SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
  2686. '                                                 OR EQUAL TO MAX.TIME!
  2687. '
  2688. '  PURPOSE -- Subroutine to check if the current time is greater
  2689. '             than or equal to the time allowed
  2690. '
  2691.       SUB CHECKTIM (MAX.TIME!) STATIC
  2692.       SUBROUTINE.PARAMETER = 1
  2693.       CALL FINDTIME (TI!)
  2694.       IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
  2695.          EXIT SUB
  2696.       IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
  2697.          SUBROUTINE.PARAMETER = 2 : _
  2698.          EXIT SUB
  2699.       TEST.TIME! = MAX.TIME! - 86400
  2700.       IF TEST.TIME! - TI! <= 0 THEN _
  2701.          EXIT SUB
  2702.       IF TI! => TEST.TIME! THEN _
  2703.          SUBROUTINE.PARAMETER = 2
  2704.       END SUB
  2705. 58080 ' $SUBTITLE: 'HASHRBBS - sub to determine where to look for user'
  2706. ' $PAGE
  2707. '
  2708. '  NAME    -- HASHRBBS
  2709. '
  2710. '  INPUTS  --     PARAMETER           MEANING
  2711. '               STRNG.TO.HASH$    USER NAME TO LOCATE
  2712. '               MAX.POSITION      MAXIMUM # USERS
  2713. '
  2714. '  OUTPUTS --     PRIME.HASH        WHERE TO LOOK FIRST
  2715. '                SECOND.HASH       LOOK THIS FAR AHEAD
  2716. '
  2717. '  PURPOSE -- Where to look for a user in users file
  2718. '             Look first at prime position, then add
  2719. '             SECOND.HASH until find or find unused record
  2720. '
  2721.       SUB HASHRBBS (STRNG.TO.HASH$,MAX.POSITION,PRIME.HASH,SECOND.HASH) STATIC
  2722.       SECOND.HASH = (ASC(MID$(STRNG.TO.HASH$,2,1)) * 10  + 7) MOD _
  2723.            MAX.POSITION
  2724.       PRIME.HASH = _
  2725.            ((ASC(STRNG.TO.HASH$) * 100  + _
  2726.              ASC(MID$(STRNG.TO.HASH$,(LEN(STRNG.TO.HASH$) / 2) + .1,1)) * _
  2727.              10  + _
  2728.              ASC(RIGHT$(STRNG.TO.HASH$,1))) _
  2729.              MOD MAX.POSITION) + 1
  2730.       END SUB
  2731. 58100 ' $SUBTITLE: 'SETOPTS - sub to set prompts based on user security'
  2732. ' $PAGE
  2733. '
  2734. '  NAME    -- SETOPTS
  2735. '
  2736. '  INPUTS  --     PARAMETER           MEANING
  2737. '                   FIRST             POSITION WHERE START LOOKING
  2738. '                   LAST              POSITION WHERE QUIT LOOKING
  2739. '                 USER.SECURITY.LEVEL SECURITY OF USER
  2740. '
  2741. '  OUTPUTS -- OPTIONS$              LIST OF COMMANDS USER CAN DO
  2742. '
  2743. '  PURPOSE -- String together what commands user can do in a section
  2744. '
  2745.       SUB SETOPTS (OPTIONS$,INVALID.OPTIONS$,FIRST,LAST) STATIC
  2746.       OPTIONS$ = ""
  2747.       INVALID.OPTIONS$ = ""
  2748.       FOR I = FIRST TO LAST
  2749.          IF USER.SECURITY.LEVEL < OPT.SEC(I) THEN _
  2750.             INVALID.OPTIONS$ = INVALID.OPTIONS$ + _
  2751.                                MID$(ALL.OPTS$,I,1) _
  2752.          ELSE IF MID$(ALL.OPTS$,I,1) <> " " THEN _
  2753.                  OPTIONS$ = OPTIONS$ + _
  2754.                             MID$(ALL.OPTS$,I,1)
  2755.       NEXT
  2756.       CALL SRTSTRNG (OPTIONS$)
  2757.       CALL SRTSTRNG (INVALID.OPTIONS$)
  2758.       END SUB
  2759. 58110 ' $SUBTITLE: 'CHKNEWBUL - sub to check whether got new bulletins'
  2760. ' $PAGE
  2761. '
  2762. '  NAME    -- CHKNEWBUL
  2763. '
  2764. '  INPUTS  --     PARAMETER           MEANING
  2765. '                 LAST.ON$          LAST DATE OF LOGON
  2766. '                                   FORMAT MM/DD/YY
  2767. '                 ACTIVE.BULLETINS  # OF BULLETING
  2768. '                 BULLETIN.PREFIX$  FILESPEC FOR BULLETINS
  2769. '
  2770. '  OUTPUTS --     NUM.NEW.BULLETS   NUMBER OF NEW BULLETINS
  2771. '                 NEW.BULLETS$      LIST OF NEW BULLET #'S
  2772. '                 Q                 WHERE LAST BULLETIN STORED
  2773. '                                      IN B$()
  2774. '                 B$()              BULLETINS #'S THAT ARE NEW
  2775. '                                      (2,3,4,...)
  2776. '
  2777. '  PURPOSE -- Checks how many bulletins have system date
  2778. '             at or later than date caller last logged on
  2779. '
  2780.       SUB CHKNEWBUL (LAST.ON$,NUM.NEW.BULLETS,NEW.BULLETS$) STATIC
  2781.       NUM.NEW.BULLETS = 0
  2782.       NEW.BULLETS$ = ":  "
  2783.       BASE.DATE# = VAL(MID$(LAST.ON$,4,2)) + (100 * VAL(MID$(LAST.ON$,1,2))) + _
  2784.                    (10000# * (1900 + VAL(MID$(LAST.ON$,7,2))))
  2785.       CALL FINDIT (BULLETIN.PREFIX$ + ".FCK")
  2786.       X = 0
  2787.       CALL QTPUT ("Checking new bulletins",0)
  2788.       IF OK THEN _
  2789.          WHILE NOT EOF(2) : _
  2790.             LINE INPUT #2,Y$ : _
  2791.             GOSUB 58112 : _
  2792.          WEND _
  2793.       ELSE FOR I = 1 TO ACTIVE.BULLETINS : _
  2794.               Y$ = MID$(STR$(I),2) : _
  2795.               GOSUB 58112 : _
  2796.            NEXT
  2797.       Q = NUM.NEW.BULLETS + 1
  2798.       IF NUM.NEW.BULLETS < 1 THEN _
  2799.          NEW.BULLETS$ = ""
  2800.       EXIT SUB
  2801. 58112 X$ = BULLETIN.PREFIX$ + _
  2802.            Y$ + _
  2803.            CHR$(0)
  2804.       CALL MARKTIME (X)
  2805.       CALL RBBSFIND (X$,IX,YY,MM,DD)
  2806.       IF IX = 0 THEN _
  2807.          FDATE# = DD + (100 * MM) + (10000# * (YY + 1980)) : _
  2808.          IF BASE.DATE# <= FDATE# THEN _
  2809.             NUM.NEW.BULLETS = NUM.NEW.BULLETS + 1 : _
  2810.             B$(NUM.NEW.BULLETS + 1) = Y$ : _
  2811.             NEW.BULLETS$ = NEW.BULLETS$ + _
  2812.             " " + _
  2813.             Y$
  2814.       RETURN
  2815.       END SUB
  2816. 58120 ' $SUBTITLE: 'SRTSTRNG - sub to sort characters in a string'
  2817. ' $PAGE
  2818. '
  2819. '  NAME    -- SRTSTRNG
  2820. '
  2821. '  INPUTS  --     PARAMETER           MEANING
  2822. '                 STRNG$           STRING TO SORT
  2823. '
  2824. '  OUTPUTS --     STRNG$           SORTED STRING
  2825. '
  2826. '  PURPOSE -- Sorts characters in passed string.
  2827. '
  2828.       SUB SRTSTRNG (STRNG$) STATIC
  2829.       S0 = LEN(STRNG$)
  2830.       S1 = S0
  2831.       X$ = "!"
  2832. 58122 S1 = S1\2
  2833.       IF S1 = 0 THEN _
  2834.          EXIT SUB
  2835.       S2 = S0 - S1
  2836.       FOR S3 = 1 TO S2
  2837.          S4 = S3
  2838. 58124    S5 = S4 + S1
  2839.          IF MID$(STRNG$,S4,1) > MID$(STRNG$,S5,1) THEN _
  2840.             LSET X$ = MID$(STRNG$,S4,1) : _
  2841.             MID$(STRNG$,S4,1) = MID$(STRNG$,S5,1) : _
  2842.             MID$(STRNG$,S5,1) = X$ : _
  2843.             S4 = S4 - S1 : _
  2844.             IF S4 > 0 THEN _
  2845.                GOTO 58124
  2846.       NEXT
  2847.       GOTO 58122
  2848.       END SUB
  2849. 58130 ' $SUBTITLE: 'INSCOMMA - sub to format commands in command prompt'
  2850. ' $PAGE
  2851. '
  2852. '  NAME    -- INSCOMMA
  2853. '
  2854. '  INPUTS  --     PARAMETER           MEANING
  2855. '                 STRNG$           STRING TO REPLACE
  2856. '
  2857. '  OUTPUTS --     STRNG$           REPLACED STRING
  2858. '
  2859. '  PURPOSE -- Inserts commands between each letter in STRNG$
  2860. '             and encloses in pointed brackets
  2861. '
  2862.       SUB INSCOMMA (STRNG$) STATIC
  2863.       L = LEN(STRNG$)
  2864.       IF L < 1 THEN _
  2865.          EXIT SUB
  2866.       LSET LINEMES$ = " <" + _
  2867.                       LEFT$(STRNG$,1)
  2868.       FOR K = 2 TO L
  2869.          MID$(LINEMES$,2 * K,2) = "," + _
  2870.                                   MID$(STRNG$,K,1)
  2871.       NEXT
  2872.       STRNG$ = LEFT$(LINEMES$,2 * L + 1) + _
  2873.                ">"
  2874.       END SUB
  2875. 58140 ' $SUBTITLE: 'LOADNEW - subroutine to get latest uploads'
  2876. ' $PAGE
  2877. '
  2878. '  NAME    -- LOADNEW
  2879. '
  2880. '  INPUTS  --     PARAMETER           MEANING
  2881. '               UPLOAD.DIRECTORY$  LIST OF FILES UPLOADED
  2882. '
  2883. '  OUTPUTS --   A$                 LATEST UPLOADS
  2884. '
  2885. '  PURPOSE -- Loads table of most recent number of uploads by date
  2886. '
  2887.       SUB LOADNEW (ARA(2)) STATIC
  2888.       IF FMS.DIRECTORY$ = "" THEN _
  2889.          EXIT SUB
  2890.       PREV.BASE$ = ""
  2891.       IF PREV.LOADNEW$ = FMS.DIRECTORY$ THEN _
  2892.          ARA(1,1) = 0 : _
  2893.          EXIT SUB
  2894.       PREV.LOADNEW$ = FMS.DIRECTORY$
  2895.       CALL OPENFMS (LAST.REC)
  2896.       FIELD 2, 23 AS PRE.DATE$, _
  2897.                 2 AS MM$, _
  2898.                 1 AS FILL1$, _
  2899.                 2 AS DD$, _
  2900.                 1 AS FILL2$, _
  2901.                 2 AS YY$, _
  2902.                 (2 + MAX.DESC.LEN) AS FILL3$, _
  2903.                 3 AS CATEGORY$, _
  2904.                 2 AS FILL4$
  2905.       MAX.RECS = UBOUND(ARA,1)
  2906.       IF MAX.RECS < 1 THEN _
  2907.          MAX.RECS = 1 _
  2908.       ELSE IF MAX.RECS > 23 THEN _
  2909.               MAX.RECS = 23
  2910.       L = 0
  2911.       K = LAST.REC
  2912.       WHILE K > 0 AND L < MAX.RECS
  2913.          GET #2,K
  2914.          IF INSTR("\= ",LEFT$(PRE.DATE$,1)) > 0 THEN _
  2915.             GOTO 58142
  2916.          IF (CAN.DOWNLOAD.FROM.UP OR CATEGORY$ <> DEFAULT.CATEGORY.CODE$) THEN _
  2917.             L = L + 1 : _
  2918.             ARA(L,1) = 372 * (VAL(YY$) - 80) + 31 * VAL(MM$) + VAL(DD$)
  2919.          IF NOT CAN.DOWNLOAD.FROM.UP THEN _
  2920.             X = MIN.SEC.TO.VIEW _
  2921.          ELSE IF CATEGORY$ = "***" THEN _
  2922.                  X = SYSOP.SECURITY.LEVEL _
  2923.               ELSE IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  2924.                       X = MIN.SEC.TO.VIEW _
  2925.                    ELSE X = OPT.SEC(19)
  2926.          ARA(L,2) = X
  2927. 58142    K = K - 1
  2928.       WEND
  2929.       CLOSE 2
  2930.       END SUB
  2931. 58150 ' $SUBTITLE: 'CTNEWFILES - sub to count how many files new'
  2932. ' $PAGE
  2933. '
  2934. '  NAME    -- CTNEWFILES
  2935. '
  2936. '  INPUTS  --     PARAMETER           MEANING
  2937. '                  LAST.ON$          Date of last logon
  2938. '                  UPLDS$            Latest uploads
  2939. '
  2940. '  OUTPUTS --    NUM.NEW.FILES       How many after last logon
  2941. '                RPT.PREFIX$         Set to "At least " if
  2942. '                                    above is a minimum
  2943. '
  2944. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  2945. '             after date of last logon that the user can download
  2946. '
  2947.       SUB CTNEWFILES (LAST.ON$,UPLDS(2),NUM.USER.FILES,RPT.PREFIX$) STATIC
  2948.       BASE.DATE = 372 * (VAL(MID$(LAST.ON$,7,2)) - 80) + _
  2949.                   31 * (VAL(MID$(LAST.ON$,1,2))) + _
  2950.                   VAL(MID$(LAST.ON$,4,2))
  2951.       NUM.NEW.FILES = 1
  2952.       NUM.USER.FILES = 0
  2953.       WHILE (BASE.DATE <= UPLDS(NUM.NEW.FILES,1) AND _
  2954.                 UPLDS(NUM.NEW.FILES,1) > 0 AND _
  2955.                 NUM.NEW.FILES < UBOUND(UPLDS,1))
  2956.          IF USER.SECURITY.LEVEL => UPLDS(NUM.NEW.FILES,2) THEN _
  2957.             NUM.USER.FILES = NUM.USER.FILES + 1
  2958.          NUM.NEW.FILES = NUM.NEW.FILES + 1
  2959.       WEND
  2960.       IF UPLDS(NUM.NEW.FILES,1) < 1 THEN _
  2961.          NUM.NEW.FILES = NUM.NEW.FILES - 1
  2962.       IF BASE.DATE <= UPLDS(NUM.NEW.FILES,1) THEN _
  2963.          RPT.PREFIX$ = "At least " _
  2964.       ELSE RPT.PREFIX$ = ""
  2965.       END SUB
  2966. 58160 ' $SUBTITLE: 'CTLINES - sub to determine file categories '
  2967. ' $PAGE
  2968. '
  2969. '  NAME    -- CTLINES
  2970. '
  2971. '  INPUTS  -- PARAMETER             MEANING
  2972. '             DIR.CATEGORY.FILE$    NAME OF THE FILE THAT HAS THE
  2973. '                                   NUMBER OF CATEGORIES IN IT.
  2974. '
  2975. '  OUTPUTS -- MAX.ENTRIES           NUMBER OF FILE CATEGORIES
  2976. '
  2977. '  PURPOSE -- Subroutine to count the number of categories that a
  2978. '             file can be classified into.
  2979. '
  2980.       SUB CTLINES (MAX.ENTRIES) STATIC
  2981.       CALL LINESNFIL (DIR.CATEGORY.FILE$,MAX.ENTRIES)
  2982.       MAX.ENTRIES = MAX.ENTRIES + 3
  2983.       IF MAX.ENTRIES < 10 THEN _
  2984.          MAX.ENTRIES = 10
  2985.       END SUB
  2986. 58161 ' $SUBTITLE: 'CTLINES - sub to determine file categories '
  2987. ' $PAGE
  2988. '
  2989. '  NAME    -- LINESNFIL
  2990. '
  2991. '  INPUTS  -- PARAMETER             MEANING
  2992. '             FILNAME$              Name of file to use
  2993. '
  2994. '  OUTPUTS -- LKNT                  Count of # of lines in file
  2995. '
  2996. '  PURPOSE -- Subroutine to count the number of categories that a
  2997. '             file can be classified into.
  2998. '
  2999.       SUB LINESNFIL (FILNAME$,LKNT) STATIC
  3000.       CALL FINDIT (FILNAME$)
  3001.       LKNT = 0
  3002.       IF OK THEN _
  3003.          WHILE NOT EOF(2) : _
  3004.             LKNT = LKNT + 1 : _
  3005.             LINE INPUT #2,A$ : _
  3006.          WEND
  3007.       CLOSE 2
  3008.       END SUB
  3009. 58162 ' $SUBTITLE: 'INITFMS - sub to initialize file management system'
  3010. ' $PAGE
  3011. '
  3012. '  NAME    -- INITFMS
  3013. '
  3014. '  INPUTS  -- PARAMETER             MEANING
  3015. '             FMS.DIRECTORY$
  3016. '
  3017. '  OUTPUTS -- CATEGORY.NAME$()  ELEMENTS 1,2, POSSIBLY MORE
  3018. '             CATEGORY.CODE$()  ELEMENTS 1,2, POSSIBLY MORE
  3019. '             CATEGORY.DESC$()  ELEMENTS 1,2, POSSIBLY MORE
  3020. '             CATEGORY.INDEX    COUNT OF # ELEMENTS IN THE FILE
  3021. '                               MANAGMENT SYSTEM
  3022. '
  3023. '  PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
  3024. '
  3025.      SUB INITFMS (CATEGORY.NAME$(1),CATEGORY.CODE$(1), _
  3026.                    CATEGORY.DESC$(1),CATEGORY.INDEX) STATIC
  3027.       BLNK$ = " "
  3028.       CATEGORY.INDEX = 0
  3029.       IF FMS.DIRECTORY$ <> "" THEN _
  3030.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3031.          CATN$ = CATEGORY.NAME$(CATEGORY.INDEX) : _
  3032.          CALL BRKFNAME (FMS.DIRECTORY$,DRVPATH$,CATN$,EXTENSION$,FALSE) : _
  3033.          CATEGORY.NAME$(CATEGORY.INDEX) = CATN$ : _
  3034.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3035.          CATEGORY.DESC$(CATEGORY.INDEX) = "All uploads"_
  3036.       ELSE LIMIT.SEARCH.TO.FMS = FALSE : _
  3037.            EXIT SUB
  3038.       IF LIMIT.SEARCH.TO.FMS OR MASTER.DIRECTORY.NAME$ = MAIN.FMS.DIRECTORY$ THEN _
  3039.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3040.          CATEGORY.NAME$(CATEGORY.INDEX) = "ALL" : _
  3041.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3042.          CATEGORY.DESC$(CATEGORY.INDEX) = "All files"
  3043.       CALL FINDIT (DIR.CATEGORY.FILE$)
  3044.       IF NOT OK THEN _
  3045.          EXIT SUB
  3046.       WHILE NOT EOF(2)
  3047.          CALL READPARMS (WORK.ARA$(),3,1)
  3048.          IF EC > 0 THEN _
  3049.             EC = 0 : _
  3050.             CALL PSCRN (DIR.CATEGORY.FILE$+" invalid.  Line" + STR$(CATEGORY.INDEX) + " needs 3 parms") : _
  3051.             CALL DELAYIT (4) _
  3052.          ELSE CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3053.               CATEGORY.NAME$(CATEGORY.INDEX) = WORK.ARA$(1) : _
  3054.               CATEGORY.CODE$(CATEGORY.INDEX) = WORK.ARA$(2) : _
  3055.               CATEGORY.DESC$(CATEGORY.INDEX) = WORK.ARA$(3) : _
  3056.               CATR$ = CATEGORY.CODE$(CATEGORY.INDEX) : _
  3057.               CALL REMOVE (CATR$,BLNK$) : _
  3058.               CATEGORY.CODE$(CATEGORY.INDEX) = CATR$
  3059.       WEND
  3060.       CLOSE 2
  3061.       END SUB
  3062. 58165 ' $SUBTITLE: 'DISUPDIR - sub to display upload direcotry'
  3063. ' $PAGE
  3064. '
  3065. '  NAME    -- DISUPDIR
  3066. '
  3067. '  INPUTS  -- PARAMETER             MEANING
  3068. '             PASSED.CATEGORIES$    FILE "CATEGORIES" TO BE INCLUDED IN
  3069. '                                   THE SEARCH.
  3070. '             SEARCH.STRING$        STRING TO SEARCH ON WITHIN THE
  3071. '                                   FILE "CATEGORIES" SELECTED
  3072. '             SEARCH.DATE$          DATE EQUAL TO OR GREATER THAN TO BE
  3073. '                                   SEARCHED FOR WITH THE "CATEGORIES"
  3074. '                                   AND THE STRING TO SEARCH.
  3075. '             DOWNLOAD.FLAG         SET TO RECORD # OF LINE TO BEGIN
  3076. '                                   VIEWING - 0 IF AT END
  3077. '
  3078. '  OUTPUTS -- DOWNLOAD.FLAG         WHENEVER DOWNLOAD REQUESTED, SETS
  3079. '                                   TO NEXT RECORD TO VIEW.  OTHERWISE
  3080. '                                   LEAVES AT ZERO
  3081. '  PURPOSE -- Display the files that meet the criteria selected in
  3082. '             RBBS-PC upload management system on the users screen.
  3083. '
  3084.       SUB DISUPDIR (PASSED.CATEGORIES$,SEARCH.STRING$, _
  3085.                     SEARCH.DATE$,DOWNLOAD.FLAG,ABORT.INDEX) STATIC
  3086.       CALL ALLCAPS (SEARCH.STRING$)
  3087.       BLNK$ = " "
  3088.       STOP.INTERRUPTS = FALSE
  3089.       CATEGORIES$ = "," + _
  3090.                     PASSED.CATEGORIES$ + _
  3091.                     ","
  3092.       CAN.DOWNLOAD = (USER.SECURITY.LEVEL => OPT.SEC(19))
  3093.       GOSUB 58185
  3094.       IF DOWNLOAD.FLAG > 0 THEN _
  3095.          UPLOAD.INDEX = DOWNLOAD.FLAG : _
  3096.          DOWNLOAD.FLAG = 0 : _
  3097.          GOTO 58180
  3098.       EXTRA.PRMPT$ = ",V)iew"
  3099.       IF CAN.DOWNLOAD THEN _
  3100.          IF TURBO.KEY.USER THEN _
  3101.             EXTRA.PRMPT$ = EXTRA.PRMPT$ + ",D)ownload" _
  3102.          ELSE EXTRA.PRMPT$ = EXTRA.PRMPT$ + ", or file(s) to download"
  3103.       MAX.PRINT = PAGE.LENGTH - 1
  3104.       BELOW.MIN.SEC = (USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW)
  3105.       NON.STOP = NON.STOP OR (PAGE.LENGTH < 1)
  3106.       CHECK.POINT = 0
  3107.       WILD.SEARCH = (INSTR(SEARCH.STRING$,"?") > 0) _
  3108.                      OR (INSTR(SEARCH.STRING$,"*") > 0)
  3109. 58168 UPLOAD.INDEX = UPLOAD.INDEX + UPINC
  3110.       IF UPLOAD.INDEX = CUTOFF.REC THEN _
  3111.          GOTO 58182
  3112.       GET #2,UPLOAD.INDEX
  3113.       CHECK.POINT = CHECK.POINT + 1
  3114.       ON INSTR("\* =",LEFT$(PART.TO.PRINT$,1)) GOTO 58168,58171,58170,58169
  3115.       GOTO 58172
  3116. 58169 A = VAL(MID$(PART.TO.PRINT$,34))
  3117.       IF USER.SECURITY.LEVEL < A THEN _
  3118.          LAST.OK = FALSE : _
  3119.          GOTO 58168
  3120.       MID$(PART.TO.PRINT$,1,13) = MID$(PART.TO.PRINT$,2,12) + " "
  3121.       A = LEN(STR$(A))
  3122.       MID$(PART.TO.PRINT$,34) = MID$(PART.TO.PRINT$,34 + A) + SPACE$(A)
  3123.       GOTO 58172
  3124. 58170 IF EXTENDED.OFF THEN _
  3125.          GOTO 58168 _
  3126.       ELSE IF LAST.OK THEN _
  3127.          GOTO 58175 _
  3128.       ELSE IF SEARCH.STRING$ <> "" AND (NOT WILD.SEARCH) AND FAILED.SEARCH THEN _
  3129.               A$ = PART.TO.PRINT$ : _
  3130.               CALL ALLCAPS (A$) : _
  3131.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3132.               IF HIGHLITE.POS > 0 THEN _
  3133.                  HIGHLITE.REC = UPLOAD.INDEX : _
  3134.                  UPLOAD.INDEX = LAST.FNAME : _
  3135.                  GET 2,UPLOAD.INDEX :_ _
  3136.                  GOTO 58175 _
  3137.               ELSE GOTO 58168 _
  3138.            ELSE GOTO 58168
  3139. 58171 IF CATEGORY$ = "***" THEN _
  3140.          GOTO 58176 _
  3141.       ELSE KEE$ = "," + CATEGORY$ + "," : _
  3142.            IF INSTR(CATEGORIES$,KEE$) > 0 THEN _
  3143.               GOTO 58176 _
  3144.            ELSE GOTO 58168
  3145. 58172 LAST.OK = FALSE
  3146.       FAILED.SEARCH = FALSE
  3147.       LAST.FNAME = UPLOAD.INDEX
  3148.       IF CATEGORY$ = "***" THEN _
  3149.          IF NOT SYSOP THEN _
  3150.             GOTO 58178
  3151.       IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  3152.          IF BELOW.MIN.SEC THEN _
  3153.             GOTO 58178
  3154. 58173 IF LEN(CATEGORIES$) > 2 THEN _
  3155.          KEE$ = "," + _
  3156.                 CATEGORY$ + _
  3157.                 "," : _
  3158.          CALL REMOVE (KEE$,BLNK$) : _
  3159.          IF INSTR(CATEGORIES$,KEE$) = 0 THEN _
  3160.             GOTO 58178
  3161.       IF SEARCH.STRING$ <> "" THEN _
  3162.          A$ = PART.TO.PRINT$ : _
  3163.          IF WILD.SEARCH THEN _
  3164.             CALL WILDFILE (SEARCH.STRING$,LEFT$(PART.TO.PRINT$,INSTR(PART.TO.PRINT$," ")-1),OK) : _
  3165.             IF OK THEN _
  3166.                GOTO 58175 _
  3167.             ELSE GOTO 58178 _
  3168.          ELSE CALL ALLCAPS (A$) : _
  3169.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3170.               IF HIGHLITE.POS > 0 THEN _
  3171.                  HIGHLITE.REC = UPLOAD.INDEX _
  3172.               ELSE FAILED.SEARCH = TRUE : _
  3173.                    GOTO 58178
  3174. 58174 IF SEARCH.DATE$ <> "" THEN _
  3175.          KEE$ = MID$(PART.TO.PRINT$,30,2) + _
  3176.                 MID$(PART.TO.PRINT$,24,2) + _
  3177.                 MID$(PART.TO.PRINT$,27,2) : _
  3178.          IF KEE$ < SEARCH.DATE$ THEN _
  3179.             IF DATE.ORDERED.FMS THEN _
  3180.                GOTO 58183 _
  3181.             ELSE GOTO 58168
  3182. '
  3183. '
  3184. ' * Allow the FMS to be both fast and interruptable if a local
  3185. ' * user or there is nothing in the input buffer by using QTPUT.
  3186. '
  3187. '
  3188. 58175 LAST.OK = TRUE
  3189. 58176 A = END.DESC
  3190.       IF LEFT$(PART.TO.PRINT$,5) = "     " THEN _
  3191.          GOTO 58178
  3192.       WHILE MID$(PART.TO.PRINT$,A,1) = " "
  3193.          A = A - 1
  3194.       WEND
  3195.       A$ = LEFT$(PART.TO.PRINT$,A)
  3196.       CALL COLORDIR (A$,"Y")
  3197.       IF UPLOAD.INDEX = HIGHLITE.REC THEN _
  3198.          HIGHLITE.REC = -1 : _
  3199.          HIGHLITE.POS = 0 : _
  3200.          CALL CHKCOLOR (A$,SEARCH.STRING$,"")
  3201. 58177 IF LOCAL.USER THEN _
  3202.          CALL QTPUT1 (A$) : _
  3203.          GOTO 58178
  3204.       CALL EOFCOMM (CHAR%)
  3205.       IF CHAR% = -1 THEN _
  3206.          CALL QTPUT1 (A$) _
  3207.       ELSE SUBROUTINE.PARAMETER = 5 : _
  3208.            CALL TPUT : _
  3209.            IF RET THEN _
  3210.               GOTO 58183
  3211. 58178 IF LINES.PRINTED <= MAX.PRINT AND CHECK.POINT < 1000 THEN _
  3212.          GOTO 58168
  3213.       CALL CHKCARRIER                                                ' KG061203
  3214.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3215.          GOTO 58183
  3216.       CALL TIMEREMAIN (TIME.REMAINING!)
  3217.       IF TIME.REMAINING! < 0.1 THEN _
  3218.          SUBROUTINE.PARAMETER = -1 : _
  3219.          GOTO 58183
  3220.       IF NON.STOP THEN _
  3221.          GOTO 58168
  3222.       IF LINES.PRINTED <= MAX.PRINT THEN _
  3223.          CALL QTPUT1 (EMPHASIZE.OFF$ + "Files checked thru " + MID$(PART.TO.PRINT$,24,8))
  3224. 58180 TURBO.KEY = -TURBO.KEY.USER
  3225.       CALL ASKMORE (EXTRA.PRMPT$, TRUE, FALSE,ABORT.INDEX,FALSE)
  3226.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3227.          GOTO 58183
  3228.       IF NO THEN _
  3229.          GOTO 58183
  3230.       CALL ALLCAPS (B$(1))
  3231.       IF B$(1) = "V" THEN _
  3232.          CALL GETARC : _
  3233.          A = UPLOAD.INDEX : _
  3234.          GOSUB 58185 : _
  3235.          UPLOAD.INDEX = A : _
  3236.          GOTO 58180
  3237.       IF B$(1) = "D" THEN _
  3238.          A$ = "Download what file(s)" : _
  3239.          SUBROUTINE.PARAMETER = 1 : _
  3240.          CALL TGET : _
  3241.          IF Q = 0 THEN _
  3242.             GOTO 58180
  3243.       IF LEN(B$(1)) > 2 THEN _
  3244.          IF NOT YES AND CAN.DOWNLOAD THEN _
  3245.             CALL SKIPLINE (1) : _
  3246.             DOWNLOAD.FLAG = UPLOAD.INDEX : _
  3247.             EXIT SUB
  3248.       IF NON.STOP THEN IF UPLOAD.INDEX > 999 THEN _
  3249.          IF (SEARCH.DATE$ = "" OR NOT EXPERT.USER) THEN _
  3250.             A$ = STR$(UPLOAD.INDEX) + _
  3251.                " lines left to search.  Really go non-stop? (Y/[N])" : _
  3252.             NO.ADVANCE = TRUE : _
  3253.             TURBO.KEY = -TURBO.KEY.USER : _
  3254.             SUBROUTINE.PARAMETER = 1 : _
  3255.             CALL TGET : _
  3256.             CALL WIPELINE (79) : _
  3257.             NON.STOP = YES                                           ' KG072301
  3258.       CHECK.POINT = 0
  3259.       GOTO 58168
  3260. 58182 IF CHAINED.DIR$ <> "" THEN _
  3261.          ACTIVE.FMS.DIRECTORY$ = CHAINED.DIR$ : _
  3262.          GOSUB 58185 : _
  3263.          GOTO 58168
  3264. 58183 CLOSE 2
  3265.       NON.STOP = (PAGE.LENGTH < 1)
  3266.       STOP.INTERRUPTS = FALSE
  3267.       A$ = ""
  3268.       EXIT SUB
  3269. 58185 CALL OPENFMS (UPLOAD.INDEX)
  3270.       END.DESC = 33 + MAX.DESC.LEN
  3271.       FIELD 2, END.DESC AS PART.TO.PRINT$, _
  3272.                3 AS CATEGORY$, _
  3273.                2 AS FILLER$
  3274.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  3275.       IF UPINC = -1 THEN _
  3276.          CUTOFF.REC = 0 : _
  3277.          UPLOAD.INDEX = UPLOAD.INDEX + 1 _
  3278.       ELSE CUTOFF.REC = UPLOAD.INDEX + 1 : _
  3279.            UPLOAD.INDEX = 0
  3280.       RETURN
  3281.       END SUB
  3282.